From b6227446d9166130cf6d30b0fc11428fe001c90c Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 5 Oct 2020 06:50:25 +0200 Subject: [PATCH 001/148] Importing dictionary module * lisp/net: Adding files connection.el, link.el, dictionary.el, imported from https://github.com/myrkr/dictionary-el.git --- lisp/net/connection.el | 159 +++++ lisp/net/dictionary.el | 1367 ++++++++++++++++++++++++++++++++++++++++ lisp/net/link.el | 129 ++++ 3 files changed, 1655 insertions(+) create mode 100644 lisp/net/connection.el create mode 100644 lisp/net/dictionary.el create mode 100644 lisp/net/link.el diff --git a/lisp/net/connection.el b/lisp/net/connection.el new file mode 100644 index 00000000000..3afcc2cb894 --- /dev/null +++ b/lisp/net/connection.el @@ -0,0 +1,159 @@ +;;; connection.el --- TCP-based client connection + +;; Author: Torsten Hilbrich +;; Keywords: network +;; Version: 1.11 + +;; 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 +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; connection allows to handle TCP-based connections in client mode +;; where text-based information are exchanged. There is special +;; support for handling CR LF (and the usual CR LF . CR LF +;; terminater). + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defmacro connection-p (connection) + "Returns non-nil if `connection' is a connection object" + (list 'get connection ''connection)) + +(defmacro connection-read-point (connection) + "Return the read point of the connection object." + (list 'get connection ''connection-read-point)) + +(defmacro connection-process (connection) + "Return the process of the connection object." + (list 'get connection ''connection-process)) + +(defmacro connection-buffer (connection) + "Return the buffer of the connection object." + (list 'get connection ''connection-buffer)) + +(defmacro connection-set-read-point (connection point) + "Set the read-point for `connection' to `point'." + (list 'put connection ''connection-read-point point)) + +(defmacro connection-set-process (connection process) + "Set the process for `connection' to `process'." + (list 'put connection ''connection-process process)) + +(defmacro connection-set-buffer (connection buffer) + "Set the buffer for `connection' to `buffer'." + (list 'put connection ''connection-buffer buffer)) + +(defun connection-create-data (buffer process point) + "Create a new connection data based on `buffer', `process', and `point'." + (let ((connection (make-symbol "connection"))) + (put connection 'connection t) + (connection-set-read-point connection point) + (connection-set-process connection process) + (connection-set-buffer connection buffer) + connection)) + +(defun connection-open (server port) + "Open a connection to `server' and `port'. +A data structure identifing the connection is returned" + + (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" + server + port))) + (process)) + (with-current-buffer process-buffer + (setq process (open-network-stream "connection" process-buffer + server port)) + (connection-create-data process-buffer process (point-min))))) + +(defun connection-status (connection) + "Return the status of the connection. +Possible return values are the symbols: +nil: argument is no connection object +'none: argument has no connection +'up: connection is open and buffer is existing +'down: connection is closed +'alone: connection is not associated with a buffer" + (if (connection-p connection) + (let ((process (connection-process connection)) + (buffer (connection-buffer connection))) + (if (not process) + 'none + (if (not (buffer-live-p buffer)) + 'alone + (if (not (eq (process-status process) 'open)) + 'down + 'up)))) + nil)) + +(defun connection-close (connection) + "Force closing of the connection." + (if (connection-p connection) + (progn + (let ((buffer (connection-buffer connection)) + (process (connection-process connection))) + (if process + (delete-process process)) + (if buffer + (kill-buffer buffer)) + + (connection-set-process connection nil) + (connection-set-buffer connection nil))))) + +(defun connection-send (connection data) + "Send `data' to the process." + (unless (eq (connection-status connection) 'up) + (error "Connection is not up")) + (with-current-buffer (connection-buffer connection) + (goto-char (point-max)) + (connection-set-read-point connection (point)) + (process-send-string (connection-process connection) data))) + +(defun connection-send-crlf (connection data) + "Send `data' together with CRLF to the process." + (connection-send connection (concat data "\r\n"))) + +(defun connection-read (connection delimiter) + "Read data until `delimiter' is found inside the buffer." + (unless (eq (connection-status connection) 'up) + (error "Connection is not up")) + (let ((case-fold-search nil) + match-end) + (with-current-buffer (connection-buffer connection) + (goto-char (connection-read-point connection)) + ;; Wait until there is enough data + (while (not (search-forward-regexp delimiter nil t)) + (accept-process-output (connection-process connection) 3) + (goto-char (connection-read-point connection))) + (setq match-end (point)) + ;; Return the result + (let ((result (buffer-substring (connection-read-point connection) + match-end))) + (connection-set-read-point connection match-end) + result)))) + +(defun connection-read-crlf (connection) + "Read until a line is completedx with CRLF" + (connection-read connection "\015?\012")) + +(defun connection-read-to-point (connection) + "Read until a line is consisting of a single point" + (connection-read connection "\015?\012[.]\015?\012")) + +(provide 'connection) +;;; connection.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el new file mode 100644 index 00000000000..9545926cb25 --- /dev/null +++ b/lisp/net/dictionary.el @@ -0,0 +1,1367 @@ +;;; dictionary.el --- Client for rfc2229 dictionary servers + +;; Author: Torsten Hilbrich +;; Keywords: interface, dictionary +;; Version: 1.11 +;; Package-Requires: ((connection "1.11") (link "1.11")) + +;; 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 +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; dictionary allows you to interact with dictionary servers. +;; Use M-x customize-group dictionary to modify user settings. +;; +;; Main functions for interaction are: +;; dictionary - opens a new dictionary buffer +;; dictionary-search - search for the definition of a word +;; +;; You can find more information in the README file of the GitHub +;; repository https://github.com/myrkr/dictionary-el + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'easymenu) +(require 'custom) +(require 'connection) +(require 'link) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Stuff for customizing. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when-compile + (unless (fboundp 'defface) + (message "Please update your custom.el file: %s" + "http://www.dina.kvl.dk/~abraham/custom/")) + + (unless (fboundp 'defgroup) + (defmacro defgroup (&rest ignored)) + (defmacro defcustom (var value doc &rest ignored) + (list 'defvar var value doc)))) + +(defvar dictionary-server) +(defun dictionary-set-server-var (name value) + (if (and (boundp 'dictionary-connection) + dictionary-connection + (eq (connection-status dictionary-connection) 'up) + (y-or-n-p + (concat "Close existing connection to " dictionary-server "? "))) + (connection-close dictionary-connection)) + (set-default name value)) + +(defgroup dictionary nil + "Client for accessing the dictd server based dictionaries" + :group 'hypermedia) + +(defgroup dictionary-proxy nil + "Proxy configuration options for the dictionary client" + :group 'dictionary) + +(defcustom dictionary-server + "dict.org" + "This server is contacted for searching the dictionary" + :group 'dictionary + :set 'dictionary-set-server-var + :type 'string) + +(defcustom dictionary-port + 2628 + "The port of the dictionary server. + This port is propably always 2628 so there should be no need to modify it." + :group 'dictionary + :set 'dictionary-set-server-var + :type 'number) + +(defcustom dictionary-identification + "dictionary.el emacs lisp dictionary client" + "This is the identification string that will be sent to the server." + :group 'dictionary + :type 'string) + +(defcustom dictionary-default-dictionary + "*" + "The dictionary which is used for searching definitions and matching. + * and ! have a special meaning, * search all dictionaries, ! search until + one dictionary yields matches." + :group 'dictionary + :type 'string) + +(defcustom dictionary-default-strategy + "." + "The default strategy for listing matching words." + :group 'dictionary + :type 'string) + +(defcustom dictionary-default-popup-strategy + "exact" + "The default strategy for listing matching words within a popup window. + +The following algorithm (defined by the dictd server) are supported +by the choice value: + +- Exact match + + The found word exactly matches the searched word. + +- Similiar sounding + + The found word sounds similiar to the searched word. For this match type + the soundex algorithm defined by Donald E. Knuth is used. It will only + works with english words and the algorithm is not very reliable (i.e., + the soundex algorithm is quite simple). + +- Levenshtein distance one + + The Levenshtein distance is defined as the number of insertions, deletions, + or replacements needed to get the searched word. This algorithm searches + for word where spelling mistakes are allowed. Levenshtein distance one + means there is either a deleted character, an inserted character, or a + modified one. + +- User choice + + Here you can enter any matching algorithm supported by your + dictionary server. +" + :group 'dictionary + :type '(choice (const :tag "Exact match" "exact") + (const :tag "Similiar sounding" "soundex") + (const :tag "Levenshtein distance one" "lev") + (string :tag "User choice"))) + +(defcustom dictionary-create-buttons + t + "Create some clickable buttons on top of the window if non-nil." + :group 'dictionary + :type 'boolean) + +(defcustom dictionary-mode-hook + nil + "Hook run in dictionary mode buffers." + :group 'dictionary + :type 'hook) + +(defcustom dictionary-use-http-proxy + nil + "Connects via a HTTP proxy using the CONNECT command when not nil." + :group 'dictionary-proxy + :set 'dictionary-set-server-var + :type 'boolean) + +(defcustom dictionary-proxy-server + "proxy" + "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." + :group 'dictionary-proxy + :set 'dictionary-set-server-var + :type 'string) + +(defcustom dictionary-proxy-port + 3128 + "The port of the proxy server, used only when dictionary-use-http-proxy is set." + :group 'dictionary-proxy + :set 'dictionary-set-server-var + :type 'number) + +(defcustom dictionary-use-single-buffer + nil + "Should the dictionary command reuse previous dictionary buffers?" + :group 'dictionary + :type 'boolean) + +(defcustom dictionary-description-open-delimiter + "" + "The delimiter to display in front of the dictionaries description" + :group 'dictionary + :type 'string) + +(defcustom dictionary-description-close-delimiter + "" + "The delimiter to display after of the dictionaries description" + :group 'dictionary + :type 'string) + +;; Define only when coding-system-list is available +(when (fboundp 'coding-system-list) + (defcustom dictionary-coding-systems-for-dictionaries + '( ("mueller" . koi8-r)) + "Mapping of dictionaries to coding systems. + Each entry in this list defines the coding system to be used for that + dictionary. The default coding system for all other dictionaries + is utf-8" + :group 'dictionary + :type `(repeat (cons :tag "Association" + (string :tag "Dictionary name") + (choice :tag "Coding system" + :value 'utf-8 + ,@(mapcar (lambda (x) (list 'const x)) + (coding-system-list)) + )))) + + ) + +(if (fboundp 'defface) + (progn + + (defface dictionary-word-definition-face + '((((supports (:family "DejaVu Serif"))) + (:family "DejaVu Serif")) + (((type x)) + (:font "Sans Serif")) + (t + (:font "default"))) + "The face that is used for displaying the definition of the word." + :group 'dictionary) + + (defface dictionary-word-entry-face + '((((type x)) + (:italic t)) + (((type tty) (class color)) + (:foreground "green")) + (t + (:inverse t))) + "The face that is used for displaying the initial word entry line." + :group 'dictionary) + + (defface dictionary-button-face + '((t + (:bold t))) + "The face that is used for displaying buttons." + :group 'dictionary) + + (defface dictionary-reference-face + '((((type x) + (class color) + (background dark)) + (:foreground "yellow")) + (((type tty) + (class color) + (background dark)) + (:foreground "cyan")) + (((class color) + (background light)) + (:foreground "blue")) + (t + (:underline t))) + + "The face that is used for displaying a reference word." + :group 'dictionary) + + ) + + ;; else + (copy-face 'italic 'dictionary-word-entry-face) + (copy-face 'bold 'dictionary-button-face) + (copy-face 'default 'dictionary-reference-face) + (set-face-foreground 'dictionary-reference-face "blue")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Buffer local variables for storing the current state +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar dictionary-window-configuration + nil + "The window configuration to be restored upon closing the buffer") + +(defvar dictionary-selected-window + nil + "The currently selected window") + +(defvar dictionary-position-stack + nil + "The history buffer for point and window position") + +(defvar dictionary-data-stack + nil + "The history buffer for functions and arguments") + +(defvar dictionary-positions + nil + "The current positions") + +(defvar dictionary-current-data + nil + "The item that will be placed on stack next time") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Global variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar dictionary-mode-map + nil + "Keymap for dictionary mode") + +(defvar dictionary-connection + nil + "The current network connection") + +(defvar dictionary-instances + 0 + "The number of open dictionary buffers") + +(defvar dictionary-marker + nil + "Stores the point position while buffer display.") + +(defvar dictionary-color-support + (condition-case nil + (x-display-color-p) + (error nil)) + "Determines if the Emacs has support to display color") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic function providing startup actions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun dictionary-mode () + "This is a mode for searching a dictionary server implementing + the protocol defined in RFC 2229. + + This is a quick reference to this mode describing the default key bindings: + + * q close the dictionary buffer + * h display this help information + * s ask for a new word to search + * d search the word at point + * n or Tab place point to the next link + * p or S-Tab place point to the prev link + + * m ask for a pattern and list all matching words. + * D select the default dictionary + * M select the default search strategy + + * Return or Button2 visit that link + * M-Return or M-Button2 search the word beneath link in all dictionaries + " + + (unless (eq major-mode 'dictionary-mode) + (incf dictionary-instances)) + + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map dictionary-mode-map) + (setq major-mode 'dictionary-mode) + (setq mode-name "Dictionary") + + (make-local-variable 'dictionary-data-stack) + (setq dictionary-data-stack nil) + (make-local-variable 'dictionary-position-stack) + (setq dictionary-position-stack nil) + + (make-local-variable 'dictionary-current-data) + (make-local-variable 'dictionary-positions) + + (make-local-variable 'dictionary-default-dictionary) + (make-local-variable 'dictionary-default-strategy) + + (if (featurep 'xemacs) + (make-local-hook 'kill-buffer-hook)) + (add-hook 'kill-buffer-hook 'dictionary-close t t) + (run-hooks 'dictionary-mode-hook)) + +;;;###autoload +(defun dictionary () + "Create a new dictonary buffer and install dictionary-mode" + (interactive) + (let ((buffer (or (and dictionary-use-single-buffer + (get-buffer "*Dictionary*")) + (generate-new-buffer "*Dictionary*"))) + (window-configuration (current-window-configuration)) + (selected-window (frame-selected-window))) + + (switch-to-buffer-other-window buffer) + (dictionary-mode) + + (make-local-variable 'dictionary-window-configuration) + (make-local-variable 'dictionary-selected-window) + (setq dictionary-window-configuration window-configuration) + (setq dictionary-selected-window selected-window) + (dictionary-check-connection) + (dictionary-new-buffer) + (dictionary-store-positions) + (dictionary-store-state 'dictionary-new-buffer nil))) + +(defun dictionary-new-buffer (&rest ignore) + "Create a new and clean buffer" + + (dictionary-pre-buffer) + (dictionary-post-buffer)) + + +(unless dictionary-mode-map + (setq dictionary-mode-map (make-sparse-keymap)) + (suppress-keymap dictionary-mode-map) + + (define-key dictionary-mode-map "q" 'dictionary-close) + (define-key dictionary-mode-map "h" 'dictionary-help) + (define-key dictionary-mode-map "s" 'dictionary-search) + (define-key dictionary-mode-map "d" 'dictionary-lookup-definition) + (define-key dictionary-mode-map "D" 'dictionary-select-dictionary) + (define-key dictionary-mode-map "M" 'dictionary-select-strategy) + (define-key dictionary-mode-map "m" 'dictionary-match-words) + (define-key dictionary-mode-map "l" 'dictionary-previous) + + (if (and (string-match "GNU" (emacs-version)) + (not window-system)) + (define-key dictionary-mode-map [9] 'dictionary-next-link) + (define-key dictionary-mode-map [tab] 'dictionary-next-link)) + + ;; shift-tabs normally is supported on window systems only, but + ;; I do not enforce it + (define-key dictionary-mode-map [(shift tab)] 'dictionary-prev-link) + (define-key dictionary-mode-map "\e\t" 'dictionary-prev-link) + (define-key dictionary-mode-map [backtab] 'dictionary-prev-link) + + (define-key dictionary-mode-map "n" 'dictionary-next-link) + (define-key dictionary-mode-map "p" 'dictionary-prev-link) + + (define-key dictionary-mode-map " " 'scroll-up) + (define-key dictionary-mode-map [(meta space)] 'scroll-down) + + (link-initialize-keymap dictionary-mode-map)) + +(defmacro dictionary-reply-code (reply) + "Return the reply code stored in `reply'." + (list 'get reply ''reply-code)) + +(defmacro dictionary-reply (reply) + "Return the string reply stored in `reply'." + (list 'get reply ''reply)) + +(defmacro dictionary-reply-list (reply) + "Return the reply list stored in `reply'." + (list 'get reply ''reply-list)) + +(defun dictionary-check-connection () + "Check if there is already a connection open" + (if (not (and dictionary-connection + (eq (connection-status dictionary-connection) 'up))) + (let ((wanted 'raw-text) + (coding-system nil)) + (if (and (fboundp 'coding-system-list) + (member wanted (coding-system-list))) + (setq coding-system wanted)) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system)) + (message "Opening connection to %s:%s" dictionary-server + dictionary-port) + (connection-close dictionary-connection) + (setq dictionary-connection + (if dictionary-use-http-proxy + (connection-open dictionary-proxy-server + dictionary-proxy-port) + (connection-open dictionary-server dictionary-port))) + (set-process-query-on-exit-flag + (connection-process dictionary-connection) + nil) + + (when dictionary-use-http-proxy + (message "Proxy CONNECT to %s:%d" + dictionary-proxy-server + dictionary-proxy-port) + (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1" + dictionary-server + dictionary-port)) + ;; just a \r\n combination + (dictionary-send-command "") + + ;; read first line of reply + (let* ((reply (dictionary-read-reply)) + (reply-list (dictionary-split-string reply))) + ;; first item is protocol, second item is code + (unless (= (string-to-number (cadr reply-list)) 200) + (error "Bad reply from proxy server %s" reply)) + + ;; skip the following header lines until empty found + (while (not (equal reply "")) + (setq reply (dictionary-read-reply))))) + + (dictionary-check-initial-reply) + (dictionary-send-command (concat "client " dictionary-identification)) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (unless (dictionary-check-reply reply 250) + (error "Unknown server answer: %s" + (dictionary-reply reply)))))))) + +(defun dictionary-mode-p () + "Return non-nil if current buffer has dictionary-mode" + (eq major-mode 'dictionary-mode)) + +(defun dictionary-ensure-buffer () + "If current buffer is not a dictionary buffer, create a new one." + (unless (dictionary-mode-p) + (dictionary))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dealing with closing the buffer +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictionary-close (&rest ignore) + "Close the current dictionary buffer and its connection" + (interactive) + (if (eq major-mode 'dictionary-mode) + (progn + (setq major-mode nil) + (if (<= (decf dictionary-instances) 0) + (connection-close dictionary-connection)) + (let ((configuration dictionary-window-configuration) + (selected-window dictionary-selected-window)) + (kill-buffer (current-buffer)) + (set-window-configuration configuration) + (select-window selected-window))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpful functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictionary-send-command (string) + "Send the command `string' to the network connection." + (dictionary-check-connection) + ;;;; ##### + (connection-send-crlf dictionary-connection string)) + +(defun dictionary-read-reply () + "Read the reply line from the server" + (let ((answer (connection-read-crlf dictionary-connection))) + (if (string-match "\r?\n" answer) + (substring answer 0 (match-beginning 0)) + answer))) + +(defun dictionary-split-string (string) + "Split the `string' constiting of space separated words into elements. +This function knows about the special meaning of quotes (\")" + (let ((list)) + (while (and string (> (length string) 0)) + (let ((search "\\(\\s-+\\)") + (start 0)) + (if (= (aref string 0) ?\") + (setq search "\\(\"\\)\\s-*" + start 1)) + (if (string-match search string start) + (progn + (setq list (cons (substring string start (- (match-end 1) 1)) list) + string (substring string (match-end 0)))) + (setq list (cons string list) + string nil)))) + (nreverse list))) + +(defun dictionary-read-reply-and-split () + "Read the reply, split it into words and return it" + (let ((answer (make-symbol "reply-data")) + (reply (dictionary-read-reply))) + (let ((reply-list (dictionary-split-string reply))) + (put answer 'reply reply) + (put answer 'reply-list reply-list) + (put answer 'reply-code (string-to-number (car reply-list))) + answer))) + +(defun dictionary-read-answer () + "Read an answer delimited by a . on a single line" + (let ((answer (connection-read-to-point dictionary-connection)) + (start 0)) + (while (string-match "\r\n" answer start) + (setq answer (replace-match "\n" t t answer)) + (setq start (1- (match-end 0)))) + (setq start 0) + (if (string-match "\n\\.\n.*" answer start) + (setq answer (replace-match "" t t answer))) + answer)) + +(defun dictionary-check-reply (reply code) + "Check if the reply in `reply' has the `code'." + (let ((number (dictionary-reply-code reply))) + (and (numberp number) + (= number code)))) + +(defun dictionary-coding-system (dictionary) + "Select coding system to use for that dictionary" + (when (boundp 'dictionary-coding-systems-for-dictionaries) + (let ((coding-system + (or (cdr (assoc dictionary + dictionary-coding-systems-for-dictionaries)) + 'utf-8))) + (if (member coding-system (coding-system-list)) + coding-system + nil)))) + +(defun dictionary-decode-charset (text dictionary) + "Convert the text from the charset defined by the dictionary given." + (let ((coding-system (dictionary-coding-system dictionary))) + (if coding-system + (decode-coding-string text coding-system) + text))) + +(defun dictionary-encode-charset (text dictionary) + "Convert the text to the charset defined by the dictionary given." + (let ((coding-system (dictionary-coding-system dictionary))) + (if coding-system + (encode-coding-string text coding-system) + text))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Communication functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictionary-check-initial-reply () + "Read the first reply from server and check it." + (let ((reply (dictionary-read-reply-and-split))) + (unless (dictionary-check-reply reply 220) + (connection-close dictionary-connection) + (error "Server returned: %s" (dictionary-reply reply))))) + +;; Store the current state +(defun dictionary-store-state (function data) + "Stores the current state of operation for later restore." + + (if dictionary-current-data + (progn + (push dictionary-current-data dictionary-data-stack) + (unless dictionary-positions + (error "dictionary-store-state called before dictionary-store-positions")) + (push dictionary-positions dictionary-position-stack))) + (setq dictionary-current-data + (cons function data))) + +(defun dictionary-store-positions () + "Stores the current positions for later restore." + + (setq dictionary-positions (cons (point) (window-start)))) + +;; Restore the previous state +(defun dictionary-restore-state (&rest ignored) + "Restore the state just before the last operation" + (let ((position (pop dictionary-position-stack)) + (data (pop dictionary-data-stack))) + (unless position + (error "Already at begin of history")) + (apply (car data) (cdr data)) + (set-window-start (selected-window) (cdr position)) + (goto-char (car position)) + (setq dictionary-current-data data))) + +;; The normal search + +(defun dictionary-new-search (args &optional all) + "Save the current state and start a new search" + (interactive) + (dictionary-store-positions) + (let ((word (car args)) + (dictionary (cdr args))) + + (if all + (setq dictionary dictionary-default-dictionary)) + (dictionary-ensure-buffer) + (dictionary-new-search-internal word dictionary 'dictionary-display-search-result) + (dictionary-store-state 'dictionary-new-search-internal + (list word dictionary 'dictionary-display-search-result)))) + +(defun dictionary-new-search-internal (word dictionary function) + "Starts a new search after preparing the buffer" + (dictionary-pre-buffer) + (dictionary-do-search word dictionary function)) + +(defun dictionary-do-search (word dictionary function &optional nomatching) + "The workhorse for doing the search" + + (message "Searching for %s in %s" word dictionary) + (dictionary-send-command (concat "define " + (dictionary-encode-charset dictionary "") + " \"" + (dictionary-encode-charset word dictionary) + "\"")) + + (message nil) + (let ((reply (dictionary-read-reply-and-split))) + (if (dictionary-check-reply reply 552) + (progn + (unless nomatching + (beep) + (insert "Word not found, maybe you are looking " + "for one of these words\n\n") + (dictionary-do-matching word + dictionary + "." + 'dictionary-display-only-match-result) + (dictionary-post-buffer))) + (if (dictionary-check-reply reply 550) + (error "Dictionary \"%s\" is unknown, please select an existing one." + dictionary) + (unless (dictionary-check-reply reply 150) + (error "Unknown server answer: %s" (dictionary-reply reply))) + (funcall function reply))))) + +(defun dictionary-pre-buffer () + "These commands are executed at the begin of a new buffer" + (setq buffer-read-only nil) + (erase-buffer) + (if dictionary-create-buttons + (progn + (link-insert-link "[Back]" 'dictionary-button-face + 'dictionary-restore-state nil + "Mouse-2 to go backwards in history") + (insert " ") + (link-insert-link "[Search Definition]" + 'dictionary-button-face + 'dictionary-search nil + "Mouse-2 to look up a new word") + (insert " ") + + (link-insert-link "[Matching words]" + 'dictionary-button-face + 'dictionary-match-words nil + "Mouse-2 to find matches for a pattern") + (insert " ") + + (link-insert-link "[Quit]" 'dictionary-button-face + 'dictionary-close nil + "Mouse-2 to close this window") + + (insert "\n ") + + (link-insert-link "[Select Dictionary]" + 'dictionary-button-face + 'dictionary-select-dictionary nil + "Mouse-2 to select dictionary for future searches") + (insert " ") + (link-insert-link "[Select Match Strategy]" + 'dictionary-button-face + 'dictionary-select-strategy nil + "Mouse-2 to select matching algorithm") + (insert "\n\n"))) + (setq dictionary-marker (point-marker))) + +(defun dictionary-post-buffer () + "These commands are executed at the end of a new buffer" + (goto-char dictionary-marker) + + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + +(defun dictionary-display-search-result (reply) + "This function starts displaying the result starting with the `reply'." + + (let ((number (nth 1 (dictionary-reply-list reply)))) + (insert number (if (equal number "1") + " definition" + " definitions") + " found\n\n") + (setq reply (dictionary-read-reply-and-split)) + (while (dictionary-check-reply reply 151) + (let* ((reply-list (dictionary-reply-list reply)) + (dictionary (nth 2 reply-list)) + (description (nth 3 reply-list)) + (word (nth 1 reply-list))) + (dictionary-display-word-entry word dictionary description) + (setq reply (dictionary-read-answer)) + (dictionary-display-word-definition reply word dictionary) + (setq reply (dictionary-read-reply-and-split)))) + (dictionary-post-buffer))) + +(defun dictionary-display-word-entry (word dictionary description) + "Insert an explanation for the current definition." + (let ((start (point))) + (insert "From " + dictionary-description-open-delimiter + (dictionary-decode-charset description dictionary) + dictionary-description-close-delimiter + " [" (dictionary-decode-charset dictionary dictionary) "]:" + "\n\n") + (put-text-property start (point) 'face 'dictionary-word-entry-face))) + +(defun dictionary-display-word-definition (reply word dictionary) + "Insert the definition for the current word" + (let ((start (point))) + (insert (dictionary-decode-charset reply dictionary)) + (insert "\n\n") + (put-text-property start (point) 'face 'dictionary-word-definition-face) + (let ((regexp "\\({+\\)\\([^ '\"][^}]*\\)\\(}+\\)")) + (goto-char start) + (while (< (point) (point-max)) + (if (search-forward-regexp regexp nil t) + (let ((match-start (match-beginning 2)) + (match-end (match-end 2))) + (if dictionary-color-support + ;; Compensate for the replacement + (let ((brace-match-length (- (match-end 1) + (match-beginning 1)))) + (setq match-start (- (match-beginning 2) + brace-match-length)) + (setq match-end (- (match-end 2) + brace-match-length)) + (replace-match "\\2"))) + (dictionary-mark-reference match-start match-end + 'dictionary-new-search + word dictionary)) + (goto-char (point-max))))))) + +(defun dictionary-mark-reference (start end call displayed-word dictionary) + "Format the area from `start' to `end' as link calling `call'. +The word is taken from the buffer, the `dictionary' is given as argument." + (let ((word (buffer-substring-no-properties start end))) + (while (string-match "\n\\s-*" word) + (setq word (replace-match " " t t word))) + (while (string-match "[*\"]" word) + (setq word (replace-match "" t t word))) + + (unless (equal word displayed-word) + (link-create-link start end 'dictionary-reference-face + call (cons word dictionary) + (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) + +(defun dictionary-select-dictionary (&rest ignored) + "Save the current state and start a dictionary selection" + (interactive) + (dictionary-ensure-buffer) + (dictionary-store-positions) + (dictionary-do-select-dictionary) + (dictionary-store-state 'dictionary-do-select-dictionary nil)) + +(defun dictionary-do-select-dictionary (&rest ignored) + "The workhorse for doing the dictionary selection." + + (message "Looking up databases and descriptions") + (dictionary-send-command "show db") + + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 554) + (error "No dictionary present") + (unless (dictionary-check-reply reply 110) + (error "Unknown server answer: %s" + (dictionary-reply reply))) + (dictionary-display-dictionarys reply)))) + +(defun dictionary-simple-split-string (string &optional pattern) + "Return a list of substrings of STRING which are separated by PATTERN. +If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." + (or pattern + (setq pattern "[ \f\t\n\r\v]+")) + ;; The FSF version of this function takes care not to cons in case + ;; of infloop. Maybe we should synch? + (let (parts (start 0)) + (while (string-match pattern string start) + (setq parts (cons (substring string start (match-beginning 0)) parts) + start (match-end 0))) + (nreverse (cons (substring string start) parts)))) + +(defun dictionary-display-dictionarys (reply) + "Handle the display of all dictionaries existing on the server" + (dictionary-pre-buffer) + (insert "Please select your default dictionary:\n\n") + (dictionary-display-dictionary-line "* \"All dictionaries\"") + (dictionary-display-dictionary-line "! \"The first matching dictionary\"") + (let* ((reply (dictionary-read-answer)) + (list (dictionary-simple-split-string reply "\n+"))) + (mapc 'dictionary-display-dictionary-line list)) + (dictionary-post-buffer)) + +(defun dictionary-display-dictionary-line (string) + "Display a single dictionary" + (let* ((list (dictionary-split-string string)) + (dictionary (car list)) + (description (cadr list)) + (translated (dictionary-decode-charset description dictionary))) + (if dictionary + (if (equal dictionary "--exit--") + (insert "(end of default search list)\n") + (link-insert-link (concat dictionary ": " translated) + 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") + (insert "\n"))))) + +(defun dictionary-set-dictionary (param &optional more) + "Select this dictionary as new default" + + (if more + (dictionary-display-more-info param) + (let ((dictionary (car param))) + (setq dictionary-default-dictionary dictionary) + (dictionary-restore-state) + (message "Dictionary %s has been selected" dictionary)))) + +(defun dictionary-display-more-info (param) + "Display the available information on the dictionary" + + (let ((dictionary (car param)) + (description (cdr param))) + (unless (or (equal dictionary "*") + (equal dictionary "!")) + (dictionary-store-positions) + (message "Requesting more information on %s" dictionary) + (dictionary-send-command + (concat "show info " (dictionary-encode-charset dictionary ""))) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 550) + (error "Dictionary \"%s\" not existing" dictionary) + (unless (dictionary-check-reply reply 112) + (error "Unknown server answer: %s" (dictionary-reply reply))) + (dictionary-pre-buffer) + (insert "Information on dictionary: ") + (link-insert-link description 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") + (insert "\n\n") + (setq reply (dictionary-read-answer)) + (insert reply) + (dictionary-post-buffer))) + + (dictionary-store-state 'dictionary-display-more-info dictionary)))) + +(defun dictionary-select-strategy (&rest ignored) + "Save the current state and start a strategy selection" + (interactive) + (dictionary-ensure-buffer) + (dictionary-store-positions) + (dictionary-do-select-strategy) + (dictionary-store-state 'dictionary-do-select-strategy nil)) + +(defun dictionary-do-select-strategy () + "The workhorse for doing the strategy selection." + + (message "Request existing matching algorithm") + (dictionary-send-command "show strat") + + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 555) + (error "No strategies available") + (unless (dictionary-check-reply reply 111) + (error "Unknown server answer: %s" + (dictionary-reply reply))) + (dictionary-display-strategies reply)))) + +(defun dictionary-display-strategies (reply) + "Handle the display of all strategies existing on the server" + (dictionary-pre-buffer) + (insert "Please select your default search strategy:\n\n") + (dictionary-display-strategy-line ". \"The servers default\"") + (let* ((reply (dictionary-read-answer)) + (list (dictionary-simple-split-string reply "\n+"))) + (mapc 'dictionary-display-strategy-line list)) + (dictionary-post-buffer)) + +(defun dictionary-display-strategy-line (string) + "Display a single strategy" + (let* ((list (dictionary-split-string string)) + (strategy (car list)) + (description (cadr list))) + (if strategy + (progn + (link-insert-link description 'dictionary-reference-face + 'dictionary-set-strategy strategy + "Mouse-2 to select this matching algorithm") + (insert "\n"))))) + +(defun dictionary-set-strategy (strategy &rest ignored) + "Select this strategy as new default" + (setq dictionary-default-strategy strategy) + (dictionary-restore-state) + (message "Strategy %s has been selected" strategy)) + +(defun dictionary-new-matching (word) + "Run a new matching search on `word'." + (dictionary-ensure-buffer) + (dictionary-store-positions) + (dictionary-do-matching word dictionary-default-dictionary + dictionary-default-strategy + 'dictionary-display-match-result) + (dictionary-store-state 'dictionary-do-matching + (list word dictionary-default-dictionary + dictionary-default-strategy + 'dictionary-display-match-result))) + +(defun dictionary-do-matching (word dictionary strategy function) + "Ask the server about matches to `word' and display it." + + (message "Lookup matching words for %s in %s using %s" + word dictionary strategy) + (dictionary-send-command + (concat "match " (dictionary-encode-charset dictionary "") " " + (dictionary-encode-charset strategy "") " \"" + (dictionary-encode-charset word "") "\"")) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (if (dictionary-check-reply reply 550) + (error "Dictionary \"%s\" is invalid" dictionary)) + (if (dictionary-check-reply reply 551) + (error "Strategy \"%s\" is invalid" strategy)) + (if (dictionary-check-reply reply 552) + (error (concat + "No match for \"%s\" with strategy \"%s\" in " + "dictionary \"%s\".") + word strategy dictionary)) + (unless (dictionary-check-reply reply 152) + (error "Unknown server answer: %s" (dictionary-reply reply))) + (funcall function reply))) + +(defun dictionary-display-only-match-result (reply) + "Display the results from the current matches without the headers." + + (let ((number (nth 1 (dictionary-reply-list reply))) + (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + (insert number " matching word" (if (equal number "1") "" "s") + " found\n\n") + (let ((result nil)) + (mapc (lambda (item) + (let* ((list (dictionary-split-string item)) + (dictionary (car list)) + (word (cadr list)) + (hash (assoc dictionary result))) + (if dictionary + (if hash + (setcdr hash (cons word (cdr hash))) + (setq result (cons + (cons dictionary (list word)) + result)))))) + list) + (dictionary-display-match-lines (reverse result))))) + +(defun dictionary-display-match-result (reply) + "Display the results from the current matches." + (dictionary-pre-buffer) + + (let ((number (nth 1 (dictionary-reply-list reply))) + (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + (insert number " matching word" (if (equal number "1") "" "s") + " found\n\n") + (let ((result nil)) + (mapc (lambda (item) + (let* ((list (dictionary-split-string item)) + (dictionary (car list)) + (word (cadr list)) + (hash (assoc dictionary result))) + (if dictionary + (if hash + (setcdr hash (cons word (cdr hash))) + (setq result (cons + (cons dictionary (list word)) + result)))))) + list) + (dictionary-display-match-lines (reverse result)))) + (dictionary-post-buffer)) + +(defun dictionary-display-match-lines (list) + "Display the match lines." + (mapc (lambda (item) + (let ((dictionary (car item)) + (word-list (cdr item))) + (insert "Matches from " dictionary ":\n") + (mapc (lambda (word) + (setq word (dictionary-decode-charset word dictionary)) + (insert " ") + (link-insert-link word + 'dictionary-reference-face + 'dictionary-new-search + (cons word dictionary) + "Mouse-2 to lookup word") + (insert "\n")) (reverse word-list)) + (insert "\n"))) + list)) + +;; Returns a sensible default for dictionary-search: +;; - if region is active returns its contents +;; - otherwise return the word near the point +(defun dictionary-search-default () + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end)) + (current-word t))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User callable commands +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun dictionary-search (word &optional dictionary) + "Search the `word' in `dictionary' if given or in all if nil. +It presents the word at point as default input and allows editing it." + (interactive + (list (let ((default (dictionary-search-default))) + (read-string (if default + (format "Search word (%s): " default) + "Search word: ") + nil nil default)) + (if current-prefix-arg + (read-string (if dictionary-default-dictionary + (format "Dictionary (%s): " dictionary-default-dictionary) + "Dictionary: ") + nil nil dictionary-default-dictionary) + dictionary-default-dictionary))) + + ;; if called by pressing the button + (unless word + (setq word (read-string "Search word: "))) + ;; just in case non-interactivly called + (unless dictionary + (setq dictionary dictionary-default-dictionary)) + (dictionary-new-search (cons word dictionary))) + +;;;###autoload +(defun dictionary-lookup-definition () + "Unconditionally lookup the word at point." + (interactive) + (dictionary-new-search (cons (current-word) dictionary-default-dictionary))) + +(defun dictionary-previous () + "Go to the previous location in the current buffer" + (interactive) + (unless (dictionary-mode-p) + (error "Current buffer is no dictionary buffer")) + (dictionary-restore-state)) + +(defun dictionary-next-link () + "Place the cursor to the next link." + (interactive) + (let ((pos (link-next-link))) + (if pos + (goto-char pos) + (error "There is no next link")))) + +(defun dictionary-prev-link () + "Place the cursor to the previous link." + (interactive) + (let ((pos (link-prev-link))) + (if pos + (goto-char pos) + (error "There is no previous link")))) + +(defun dictionary-help () + "Display a little help" + (interactive) + (describe-function 'dictionary-mode)) + +;;;###autoload +(defun dictionary-match-words (&optional pattern &rest ignored) + "Search `pattern' in current default dictionary using default strategy." + (interactive) + ;; can't use interactive because of mouse events + (or pattern + (setq pattern (read-string "Search pattern: "))) + (dictionary-new-matching pattern)) + +;;;###autoload +(defun dictionary-mouse-popup-matching-words (event) + "Display entries matching the word at the cursor" + (interactive "e") + (let ((word (save-window-excursion + (save-excursion + (mouse-set-point event) + (current-word))))) + (selected-window) + (dictionary-popup-matching-words word))) + +;;;###autoload +(defun dictionary-popup-matching-words (&optional word) + "Display entries matching the word at the point" + (interactive) + (unless (functionp 'popup-menu) + (error "Sorry, popup menus are not available in this emacs version")) + (dictionary-do-matching (or word (current-word)) + dictionary-default-dictionary + dictionary-default-popup-strategy + 'dictionary-process-popup-replies)) + +(defun dictionary-process-popup-replies (reply) + (let ((number (nth 1 (dictionary-reply-list reply))) + (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + + (let ((result (mapcar (lambda (item) + (let* ((list (dictionary-split-string item)) + (dictionary (car list)) + (word (dictionary-decode-charset + (cadr list) dictionary))) + (message word) + (if (equal word "") + [ "-" nil nil] + (vector (concat "[" dictionary "] " word) + `(dictionary-new-search + '(,word . ,dictionary)) + t )))) + + list))) + (let ((menu (make-sparse-keymap 'dictionary-popup))) + + (easy-menu-define dictionary-mode-map-menu dictionary-mode-map + "Menu used for displaying dictionary popup" + (cons "Matching words" + `(,@result))) + (popup-menu dictionary-mode-map-menu))))) + +;;; Tooltip support + +;; Common to GNU Emacs and XEmacs + +;; Add a mode indicater named "Dict" +(defvar dictionary-tooltip-mode + nil + "Indicates wheather the dictionary tooltip mode is active") +(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict"))) + +(defcustom dictionary-tooltip-dictionary + nil + "This dictionary to lookup words for tooltips" + :group 'dictionary + :type '(choice (const :tag "None" nil) string)) + +(defun dictionary-definition (word &optional dictionary) + (interactive) + (unwind-protect + (let ((dictionary (or dictionary dictionary-default-dictionary))) + (dictionary-do-search word dictionary 'dictionary-read-definition t)) + nil)) + +(defun dictionary-read-definition (reply) + (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) + (mapconcat 'identity (cdr list) "\n"))) + +(defconst dictionary-use-balloon-help + (eval-when-compile + (condition-case nil + (require 'balloon-help) + (error nil)))) + +(make-variable-buffer-local 'dictionary-balloon-help-extent) + +(if dictionary-use-balloon-help + (progn + +;; The following definition are only valid for XEmacs with balloon-help + +(defvar dictionary-balloon-help-position nil + "Current position to lookup word") + +(defun dictionary-balloon-help-store-position (event) + (setq dictionary-balloon-help-position (event-point event))) + +(defun dictionary-balloon-help-description (&rest extent) + "Get the word from the cursor and lookup it" + (if dictionary-balloon-help-position + (let ((word (save-window-excursion + (save-excursion + (goto-char dictionary-balloon-help-position) + (current-word))))) + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (dictionary-decode-charset definition + dictionary-tooltip-dictionary) + nil))))) + +(defvar dictionary-balloon-help-extent nil + "The extent for activating the balloon help") + +;;;###autoload +(defun dictionary-tooltip-mode (&optional arg) + "Display tooltips for the current word" + (interactive "P") + (let* ((on (if arg + (> (prefix-numeric-value arg) 0) + (not dictionary-tooltip-mode)))) + (make-local-variable 'dictionary-tooltip-mode) + (if on + ;; active mode + (progn + ;; remove old extend + (if dictionary-balloon-help-extent + (delete-extent dictionary-balloon-help-extent)) + ;; create new one + (setq dictionary-balloon-help-extent (make-extent (point-min) + (point-max))) + (set-extent-property dictionary-balloon-help-extent + 'balloon-help + 'dictionary-balloon-help-description) + (set-extent-property dictionary-balloon-help-extent + 'start-open nil) + (set-extent-property dictionary-balloon-help-extent + 'end-open nil) + (add-hook 'mouse-motion-hook + 'dictionary-balloon-help-store-position)) + + ;; deactivate mode + (if dictionary-balloon-help-extent + (delete-extent dictionary-balloon-help-extent)) + (remove-hook 'mouse-motion-hook + 'dictionary-balloon-help-store-position)) + (setq dictionary-tooltip-mode on) + (balloon-help-minor-mode on))) + +) ;; end of XEmacs part + +(defvar global-dictionary-tooltip-mode + nil) + +;;; Tooltip support for GNU Emacs +(defun dictionary-display-tooltip (event) + "Search the current word in the `dictionary-tooltip-dictionary'." + (interactive "e") + (if dictionary-tooltip-dictionary + (let ((word (save-window-excursion + (save-excursion + (mouse-set-point event) + (current-word))))) + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (tooltip-show + (dictionary-decode-charset definition + dictionary-tooltip-dictionary))) + t)) + nil)) + +;;;###autoload +(defun dictionary-tooltip-mode (&optional arg) + "Display tooltips for the current word" + (interactive "P") + (require 'tooltip) + (let ((on (if arg + (> (prefix-numeric-value arg) 0) + (not dictionary-tooltip-mode)))) + (make-local-variable 'dictionary-tooltip-mode) + (setq dictionary-tooltip-mode on) + ;; make sure that tooltip is still (global available) even is on + ;; if nil + (tooltip-mode 1) + (add-hook 'tooltip-hook 'dictionary-display-tooltip) + (make-local-variable 'track-mouse) + (setq track-mouse on))) + +;;;###autoload +(defun global-dictionary-tooltip-mode (&optional arg) + "Enable/disable dictionary-tooltip-mode for all buffers" + (interactive "P") + (require 'tooltip) + (let* ((on (if arg (> (prefix-numeric-value arg) 0) + (not global-dictionary-tooltip-mode))) + (hook-fn (if on 'add-hook 'remove-hook))) + (setq global-dictionary-tooltip-mode on) + (tooltip-mode 1) + (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip) + (setq-default dictionary-tooltip-mode on) + (setq-default track-mouse on))) + +) ;; end of GNU Emacs part + +(provide 'dictionary) + +;;; dictionary.el ends here diff --git a/lisp/net/link.el b/lisp/net/link.el new file mode 100644 index 00000000000..30eadb10176 --- /dev/null +++ b/lisp/net/link.el @@ -0,0 +1,129 @@ +;;; link.el --- Hypertext links in text buffers + +;; Author: Torsten Hilbrich +;; Keywords: interface, hypermedia +;; Version: 1.11 + +;; 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 +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file contains functions for using links in buffers. A link is +;; a part of the buffer marked with a special face, beeing +;; hightlighted while the mouse points to it and beeing activated when +;; pressing return or clicking the button2. + +;; Which each link a function and some data are associated. Upon +;; clicking the function is called with the data as only +;; argument. Both the function and the data are stored in text +;; properties. +;; +;; link-create-link - insert a new link for the text in the given range +;; link-initialize-keymap - install the keybinding for selecting links + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defun link-create-link (start end face function &optional data help) + "Create a link in the current buffer starting from `start' going to `end'. +The `face' is used for displaying, the `data' are stored together with the +link. Upon clicking the `function' is called with `data' as argument." + (let ((properties `(face ,face + mouse-face highlight + link t + link-data ,data + help-echo ,help + link-function ,function))) + (remove-text-properties start end properties) + (add-text-properties start end properties))) + +(defun link-insert-link (text face function &optional data help) + "Insert the `text' at point to be formatted as link. +The `face' is used for displaying, the `data' are stored together with the +link. Upon clicking the `function' is called with `data' as argument." + (let ((start (point))) + (insert text) + (link-create-link start (point) face function data help))) + +(defun link-selected (&optional all) + "Is called upon clicking or otherwise visiting the link." + (interactive) + + (let* ((properties (text-properties-at (point))) + (function (plist-get properties 'link-function)) + (data (plist-get properties 'link-data))) + (if function + (funcall function data all)))) + +(defun link-selected-all () + "Called for meta clicking the link" + (interactive) + (link-selected 'all)) + +(defun link-mouse-click (event &optional all) + "Is called upon clicking the link." + (interactive "@e") + + (mouse-set-point event) + (link-selected)) + +(defun link-mouse-click-all (event) + "Is called upon meta clicking the link." + (interactive "@e") + + (mouse-set-point event) + (link-selected-all)) + +(defun link-next-link () + "Return the position of the next link or nil if there is none" + (let* ((pos (point)) + (pos (next-single-property-change pos 'link))) + (if pos + (if (text-property-any pos (min (1+ pos) (point-max)) 'link t) + pos + (next-single-property-change pos 'link)) + nil))) + + +(defun link-prev-link () + "Return the position of the previous link or nil if there is none" + (let* ((pos (point)) + (pos (previous-single-property-change pos 'link))) + (if pos + (if (text-property-any pos (1+ pos) 'link t) + pos + (let ((val (previous-single-property-change pos 'link))) + (if val + val + (text-property-any (point-min) (1+ (point-min)) 'link t)))) + nil))) + +(defun link-initialize-keymap (keymap) + "Defines the necessary bindings inside keymap" + + (if (and (boundp 'running-xemacs) running-xemacs) + (progn + (define-key keymap [button2] 'link-mouse-click) + (define-key keymap [(meta button2)] 'link-mouse-click-all)) + (define-key keymap [mouse-2] 'link-mouse-click) + (define-key keymap [M-mouse-2] 'link-mouse-click-all)) + (define-key keymap "\r" 'link-selected) + (define-key keymap "\M-\r" 'link-selected-all)) + +(provide 'link) +;;; link.el ends here From 658ec3ccee50cd36ee2de267c4d91f7f6e2845a2 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 5 Oct 2020 06:56:59 +0200 Subject: [PATCH 002/148] Renamed connection.el * lisp/net/connection.el: Renamed to dictionary-connection.el, also prefixing all functions with "dictionary-" prefix * lisp/net/dictionary.el: Adapt to renamed functions --- lisp/net/connection.el | 159 ------------------------------ lisp/net/dictionary-connection.el | 156 +++++++++++++++++++++++++++++ lisp/net/dictionary.el | 28 +++--- 3 files changed, 170 insertions(+), 173 deletions(-) delete mode 100644 lisp/net/connection.el create mode 100644 lisp/net/dictionary-connection.el diff --git a/lisp/net/connection.el b/lisp/net/connection.el deleted file mode 100644 index 3afcc2cb894..00000000000 --- a/lisp/net/connection.el +++ /dev/null @@ -1,159 +0,0 @@ -;;; connection.el --- TCP-based client connection - -;; Author: Torsten Hilbrich -;; Keywords: network -;; Version: 1.11 - -;; 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 -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This file 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; connection allows to handle TCP-based connections in client mode -;; where text-based information are exchanged. There is special -;; support for handling CR LF (and the usual CR LF . CR LF -;; terminater). - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(defmacro connection-p (connection) - "Returns non-nil if `connection' is a connection object" - (list 'get connection ''connection)) - -(defmacro connection-read-point (connection) - "Return the read point of the connection object." - (list 'get connection ''connection-read-point)) - -(defmacro connection-process (connection) - "Return the process of the connection object." - (list 'get connection ''connection-process)) - -(defmacro connection-buffer (connection) - "Return the buffer of the connection object." - (list 'get connection ''connection-buffer)) - -(defmacro connection-set-read-point (connection point) - "Set the read-point for `connection' to `point'." - (list 'put connection ''connection-read-point point)) - -(defmacro connection-set-process (connection process) - "Set the process for `connection' to `process'." - (list 'put connection ''connection-process process)) - -(defmacro connection-set-buffer (connection buffer) - "Set the buffer for `connection' to `buffer'." - (list 'put connection ''connection-buffer buffer)) - -(defun connection-create-data (buffer process point) - "Create a new connection data based on `buffer', `process', and `point'." - (let ((connection (make-symbol "connection"))) - (put connection 'connection t) - (connection-set-read-point connection point) - (connection-set-process connection process) - (connection-set-buffer connection buffer) - connection)) - -(defun connection-open (server port) - "Open a connection to `server' and `port'. -A data structure identifing the connection is returned" - - (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" - server - port))) - (process)) - (with-current-buffer process-buffer - (setq process (open-network-stream "connection" process-buffer - server port)) - (connection-create-data process-buffer process (point-min))))) - -(defun connection-status (connection) - "Return the status of the connection. -Possible return values are the symbols: -nil: argument is no connection object -'none: argument has no connection -'up: connection is open and buffer is existing -'down: connection is closed -'alone: connection is not associated with a buffer" - (if (connection-p connection) - (let ((process (connection-process connection)) - (buffer (connection-buffer connection))) - (if (not process) - 'none - (if (not (buffer-live-p buffer)) - 'alone - (if (not (eq (process-status process) 'open)) - 'down - 'up)))) - nil)) - -(defun connection-close (connection) - "Force closing of the connection." - (if (connection-p connection) - (progn - (let ((buffer (connection-buffer connection)) - (process (connection-process connection))) - (if process - (delete-process process)) - (if buffer - (kill-buffer buffer)) - - (connection-set-process connection nil) - (connection-set-buffer connection nil))))) - -(defun connection-send (connection data) - "Send `data' to the process." - (unless (eq (connection-status connection) 'up) - (error "Connection is not up")) - (with-current-buffer (connection-buffer connection) - (goto-char (point-max)) - (connection-set-read-point connection (point)) - (process-send-string (connection-process connection) data))) - -(defun connection-send-crlf (connection data) - "Send `data' together with CRLF to the process." - (connection-send connection (concat data "\r\n"))) - -(defun connection-read (connection delimiter) - "Read data until `delimiter' is found inside the buffer." - (unless (eq (connection-status connection) 'up) - (error "Connection is not up")) - (let ((case-fold-search nil) - match-end) - (with-current-buffer (connection-buffer connection) - (goto-char (connection-read-point connection)) - ;; Wait until there is enough data - (while (not (search-forward-regexp delimiter nil t)) - (accept-process-output (connection-process connection) 3) - (goto-char (connection-read-point connection))) - (setq match-end (point)) - ;; Return the result - (let ((result (buffer-substring (connection-read-point connection) - match-end))) - (connection-set-read-point connection match-end) - result)))) - -(defun connection-read-crlf (connection) - "Read until a line is completedx with CRLF" - (connection-read connection "\015?\012")) - -(defun connection-read-to-point (connection) - "Read until a line is consisting of a single point" - (connection-read connection "\015?\012[.]\015?\012")) - -(provide 'connection) -;;; connection.el ends here diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el new file mode 100644 index 00000000000..f1d11bf3c57 --- /dev/null +++ b/lisp/net/dictionary-connection.el @@ -0,0 +1,156 @@ +;;; dictionary-connection.el --- TCP-based client connection for dictionary + +;; Author: Torsten Hilbrich +;; Keywords: network +;; Version: 1.11 + +;; 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 +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; dictionary-connection allows to handle TCP-based connections in +;; client mode where text-based information are exchanged. There is +;; special support for handling CR LF (and the usual CR LF . CR LF +;; terminater). + +;;; Code: + +(defmacro dictionary-connection-p (connection) + "Returns non-nil if `connection' is a connection object" + (list 'get connection ''connection)) + +(defmacro dictionary-connection-read-point (connection) + "Return the read point of the connection object." + (list 'get connection ''dictionary-connection-read-point)) + +(defmacro dictionary-connection-process (connection) + "Return the process of the connection object." + (list 'get connection ''dictionary-connection-process)) + +(defmacro dictionary-connection-buffer (connection) + "Return the buffer of the connection object." + (list 'get connection ''dictionary-connection-buffer)) + +(defmacro dictionary-connection-set-read-point (connection point) + "Set the read-point for `connection' to `point'." + (list 'put connection ''dictionary-connection-read-point point)) + +(defmacro dictionary-connection-set-process (connection process) + "Set the process for `connection' to `process'." + (list 'put connection ''dictionary-connection-process process)) + +(defmacro dictionary-connection-set-buffer (connection buffer) + "Set the buffer for `connection' to `buffer'." + (list 'put connection ''dictionary-connection-buffer buffer)) + +(defun dictionary-connection-create-data (buffer process point) + "Create a new connection data based on `buffer', `process', and `point'." + (let ((connection (make-symbol "connection"))) + (put connection 'connection t) + (dictionary-connection-set-read-point connection point) + (dictionary-connection-set-process connection process) + (dictionary-connection-set-buffer connection buffer) + connection)) + +(defun dictionary-connection-open (server port) + "Open a connection to `server' and `port'. +A data structure identifing the connection is returned" + + (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" + server + port))) + (process)) + (with-current-buffer process-buffer + (setq process (open-network-stream "connection" process-buffer + server port)) + (dictionary-connection-create-data process-buffer process (point-min))))) + +(defun dictionary-connection-status (connection) + "Return the status of the connection. +Possible return values are the symbols: +nil: argument is no connection object +'none: argument has no connection +'up: connection is open and buffer is existing +'down: connection is closed +'alone: connection is not associated with a buffer" + (if (dictionary-connection-p connection) + (let ((process (dictionary-connection-process connection)) + (buffer (dictionary-connection-buffer connection))) + (if (not process) + 'none + (if (not (buffer-live-p buffer)) + 'alone + (if (not (eq (process-status process) 'open)) + 'down + 'up)))) + nil)) + +(defun dictionary-connection-close (connection) + "Force closing of the connection." + (if (dictionary-connection-p connection) + (progn + (let ((buffer (dictionary-connection-buffer connection)) + (process (dictionary-connection-process connection))) + (if process + (delete-process process)) + (if buffer + (kill-buffer buffer)) + + (dictionary-connection-set-process connection nil) + (dictionary-connection-set-buffer connection nil))))) + +(defun dictionary-connection-send (connection data) + "Send `data' to the process." + (unless (eq (dictionary-connection-status connection) 'up) + (error "Connection is not up")) + (with-current-buffer (dictionary-connection-buffer connection) + (goto-char (point-max)) + (dictionary-connection-set-read-point connection (point)) + (process-send-string (dictionary-connection-process connection) data))) + +(defun dictionary-connection-send-crlf (connection data) + "Send `data' together with CRLF to the process." + (dictionary-connection-send connection (concat data "\r\n"))) + +(defun dictionary-connection-read (connection delimiter) + "Read data until `delimiter' is found inside the buffer." + (unless (eq (dictionary-connection-status connection) 'up) + (error "Connection is not up")) + (let ((case-fold-search nil) + match-end) + (with-current-buffer (dictionary-connection-buffer connection) + (goto-char (dictionary-connection-read-point connection)) + ;; Wait until there is enough data + (while (not (search-forward-regexp delimiter nil t)) + (accept-process-output (dictionary-connection-process connection) 3) + (goto-char (dictionary-connection-read-point connection))) + (setq match-end (point)) + ;; Return the result + (let ((result (buffer-substring (dictionary-connection-read-point connection) + match-end))) + (dictionary-connection-set-read-point connection match-end) + result)))) + +(defun dictionary-connection-read-crlf (connection) + "Read until a line is completedx with CRLF" + (dictionary-connection-read connection "\015?\012")) + +(defun dictionary-connection-read-to-point (connection) + "Read until a line is consisting of a single point" + (dictionary-connection-read connection "\015?\012[.]\015?\012")) + +(provide 'dictionary-connection) +;;; dictionary-connection.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 9545926cb25..7dd88e6e42e 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -39,7 +39,7 @@ (require 'easymenu) (require 'custom) -(require 'connection) +(require 'dictionary-connection) (require 'link) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -60,10 +60,10 @@ (defun dictionary-set-server-var (name value) (if (and (boundp 'dictionary-connection) dictionary-connection - (eq (connection-status dictionary-connection) 'up) + (eq (dictionary-connection-status dictionary-connection) 'up) (y-or-n-p (concat "Close existing connection to " dictionary-server "? "))) - (connection-close dictionary-connection)) + (dictionary-connection-close dictionary-connection)) (set-default name value)) (defgroup dictionary nil @@ -451,7 +451,7 @@ by the choice value: (defun dictionary-check-connection () "Check if there is already a connection open" (if (not (and dictionary-connection - (eq (connection-status dictionary-connection) 'up))) + (eq (dictionary-connection-status dictionary-connection) 'up))) (let ((wanted 'raw-text) (coding-system nil)) (if (and (fboundp 'coding-system-list) @@ -461,14 +461,14 @@ by the choice value: (coding-system-for-write coding-system)) (message "Opening connection to %s:%s" dictionary-server dictionary-port) - (connection-close dictionary-connection) + (dictionary-connection-close dictionary-connection) (setq dictionary-connection (if dictionary-use-http-proxy - (connection-open dictionary-proxy-server - dictionary-proxy-port) - (connection-open dictionary-server dictionary-port))) + (dictionary-connection-open dictionary-proxy-server + dictionary-proxy-port) + (dictionary-connection-open dictionary-server dictionary-port))) (set-process-query-on-exit-flag - (connection-process dictionary-connection) + (dictionary-connection-process dictionary-connection) nil) (when dictionary-use-http-proxy @@ -520,7 +520,7 @@ by the choice value: (progn (setq major-mode nil) (if (<= (decf dictionary-instances) 0) - (connection-close dictionary-connection)) + (dictionary-connection-close dictionary-connection)) (let ((configuration dictionary-window-configuration) (selected-window dictionary-selected-window)) (kill-buffer (current-buffer)) @@ -535,11 +535,11 @@ by the choice value: "Send the command `string' to the network connection." (dictionary-check-connection) ;;;; ##### - (connection-send-crlf dictionary-connection string)) + (dictionary-connection-send-crlf dictionary-connection string)) (defun dictionary-read-reply () "Read the reply line from the server" - (let ((answer (connection-read-crlf dictionary-connection))) + (let ((answer (dictionary-connection-read-crlf dictionary-connection))) (if (string-match "\r?\n" answer) (substring answer 0 (match-beginning 0)) answer))) @@ -574,7 +574,7 @@ This function knows about the special meaning of quotes (\")" (defun dictionary-read-answer () "Read an answer delimited by a . on a single line" - (let ((answer (connection-read-to-point dictionary-connection)) + (let ((answer (dictionary-connection-read-to-point dictionary-connection)) (start 0)) (while (string-match "\r\n" answer start) (setq answer (replace-match "\n" t t answer)) @@ -623,7 +623,7 @@ This function knows about the special meaning of quotes (\")" "Read the first reply from server and check it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) - (connection-close dictionary-connection) + (dictionary-connection-close dictionary-connection) (error "Server returned: %s" (dictionary-reply reply))))) ;; Store the current state From e2ebffdd62c633d9b39994381adeccaacfe5d129 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 5 Oct 2020 07:11:25 +0200 Subject: [PATCH 003/148] Renamed link.el * lisp/net/link.el: Renamed to connection-link.el, also prefixing all functions with "dictionary-" prefix * lisp/net/dictionary.el: Adapt to renamed functions --- lisp/net/{link.el => dictionary-link.el} | 51 ++++++------- lisp/net/dictionary.el | 94 ++++++++++++------------ 2 files changed, 71 insertions(+), 74 deletions(-) rename lisp/net/{link.el => dictionary-link.el} (72%) diff --git a/lisp/net/link.el b/lisp/net/dictionary-link.el similarity index 72% rename from lisp/net/link.el rename to lisp/net/dictionary-link.el index 30eadb10176..86e853e64e6 100644 --- a/lisp/net/link.el +++ b/lisp/net/dictionary-link.el @@ -1,4 +1,4 @@ -;;; link.el --- Hypertext links in text buffers +;;; dictionary-link.el --- Hypertext links in text buffers ;; Author: Torsten Hilbrich ;; Keywords: interface, hypermedia @@ -31,15 +31,12 @@ ;; argument. Both the function and the data are stored in text ;; properties. ;; -;; link-create-link - insert a new link for the text in the given range -;; link-initialize-keymap - install the keybinding for selecting links +;; dictionary-link-create-link - insert a new link for the text in the given range +;; dictionary-link-initialize-keymap - install the keybinding for selecting links ;;; Code: -(eval-when-compile - (require 'cl)) - -(defun link-create-link (start end face function &optional data help) +(defun dictionary-link-create-link (start end face function &optional data help) "Create a link in the current buffer starting from `start' going to `end'. The `face' is used for displaying, the `data' are stored together with the link. Upon clicking the `function' is called with `data' as argument." @@ -52,15 +49,15 @@ link. Upon clicking the `function' is called with `data' as argument." (remove-text-properties start end properties) (add-text-properties start end properties))) -(defun link-insert-link (text face function &optional data help) +(defun dictionary-link-insert-link (text face function &optional data help) "Insert the `text' at point to be formatted as link. The `face' is used for displaying, the `data' are stored together with the link. Upon clicking the `function' is called with `data' as argument." (let ((start (point))) (insert text) - (link-create-link start (point) face function data help))) + (dictionary-link-create-link start (point) face function data help))) -(defun link-selected (&optional all) +(defun dictionary-link-selected (&optional all) "Is called upon clicking or otherwise visiting the link." (interactive) @@ -70,26 +67,26 @@ link. Upon clicking the `function' is called with `data' as argument." (if function (funcall function data all)))) -(defun link-selected-all () +(defun dictionary-link-selected-all () "Called for meta clicking the link" (interactive) - (link-selected 'all)) + (dictionary-link-selected 'all)) -(defun link-mouse-click (event &optional all) +(defun dictionary-link-mouse-click (event &optional all) "Is called upon clicking the link." (interactive "@e") (mouse-set-point event) - (link-selected)) + (dictionary-link-selected)) -(defun link-mouse-click-all (event) +(defun dictionary-link-mouse-click-all (event) "Is called upon meta clicking the link." (interactive "@e") (mouse-set-point event) - (link-selected-all)) + (dictionary-link-selected-all)) -(defun link-next-link () +(defun dictionary-link-next-link () "Return the position of the next link or nil if there is none" (let* ((pos (point)) (pos (next-single-property-change pos 'link))) @@ -100,7 +97,7 @@ link. Upon clicking the `function' is called with `data' as argument." nil))) -(defun link-prev-link () +(defun dictionary-link-prev-link () "Return the position of the previous link or nil if there is none" (let* ((pos (point)) (pos (previous-single-property-change pos 'link))) @@ -113,17 +110,17 @@ link. Upon clicking the `function' is called with `data' as argument." (text-property-any (point-min) (1+ (point-min)) 'link t)))) nil))) -(defun link-initialize-keymap (keymap) +(defun dictionary-link-initialize-keymap (keymap) "Defines the necessary bindings inside keymap" (if (and (boundp 'running-xemacs) running-xemacs) (progn - (define-key keymap [button2] 'link-mouse-click) - (define-key keymap [(meta button2)] 'link-mouse-click-all)) - (define-key keymap [mouse-2] 'link-mouse-click) - (define-key keymap [M-mouse-2] 'link-mouse-click-all)) - (define-key keymap "\r" 'link-selected) - (define-key keymap "\M-\r" 'link-selected-all)) + (define-key keymap [button2] 'dictionary-link-mouse-click) + (define-key keymap [(meta button2)] 'dictionary-link-mouse-click-all)) + (define-key keymap [mouse-2] 'dictionary-link-mouse-click) + (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all)) + (define-key keymap "\r" 'dictionary-link-selected) + (define-key keymap "\M-\r" 'dictionary-link-selected-all)) -(provide 'link) -;;; link.el ends here +(provide 'dictionary-link) +;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7dd88e6e42e..4b2f25c26b4 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -40,7 +40,7 @@ (require 'easymenu) (require 'custom) (require 'dictionary-connection) -(require 'link) +(require 'dictionary-link) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -434,7 +434,7 @@ by the choice value: (define-key dictionary-mode-map " " 'scroll-up) (define-key dictionary-mode-map [(meta space)] 'scroll-down) - (link-initialize-keymap dictionary-mode-map)) + (dictionary-link-initialize-keymap dictionary-mode-map)) (defmacro dictionary-reply-code (reply) "Return the reply code stored in `reply'." @@ -713,37 +713,37 @@ This function knows about the special meaning of quotes (\")" (erase-buffer) (if dictionary-create-buttons (progn - (link-insert-link "[Back]" 'dictionary-button-face - 'dictionary-restore-state nil - "Mouse-2 to go backwards in history") + (dictionary-link-insert-link "[Back]" 'dictionary-button-face + 'dictionary-restore-state nil + "Mouse-2 to go backwards in history") (insert " ") - (link-insert-link "[Search Definition]" - 'dictionary-button-face - 'dictionary-search nil - "Mouse-2 to look up a new word") + (dictionary-link-insert-link "[Search Definition]" + 'dictionary-button-face + 'dictionary-search nil + "Mouse-2 to look up a new word") (insert " ") - (link-insert-link "[Matching words]" - 'dictionary-button-face - 'dictionary-match-words nil - "Mouse-2 to find matches for a pattern") + (dictionary-link-insert-link "[Matching words]" + 'dictionary-button-face + 'dictionary-match-words nil + "Mouse-2 to find matches for a pattern") (insert " ") - (link-insert-link "[Quit]" 'dictionary-button-face - 'dictionary-close nil - "Mouse-2 to close this window") + (dictionary-link-insert-link "[Quit]" 'dictionary-button-face + 'dictionary-close nil + "Mouse-2 to close this window") (insert "\n ") - (link-insert-link "[Select Dictionary]" - 'dictionary-button-face - 'dictionary-select-dictionary nil - "Mouse-2 to select dictionary for future searches") + (dictionary-link-insert-link "[Select Dictionary]" + 'dictionary-button-face + 'dictionary-select-dictionary nil + "Mouse-2 to select dictionary for future searches") (insert " ") - (link-insert-link "[Select Match Strategy]" - 'dictionary-button-face - 'dictionary-select-strategy nil - "Mouse-2 to select matching algorithm") + (dictionary-link-insert-link "[Select Match Strategy]" + 'dictionary-button-face + 'dictionary-select-strategy nil + "Mouse-2 to select matching algorithm") (insert "\n\n"))) (setq dictionary-marker (point-marker))) @@ -821,10 +821,10 @@ The word is taken from the buffer, the `dictionary' is given as argument." (setq word (replace-match "" t t word))) (unless (equal word displayed-word) - (link-create-link start end 'dictionary-reference-face - call (cons word dictionary) - (concat "Press Mouse-2 to lookup \"" - word "\" in \"" dictionary "\""))))) + (dictionary-link-create-link start end 'dictionary-reference-face + call (cons word dictionary) + (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) "Save the current state and start a dictionary selection" @@ -882,11 +882,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if dictionary (if (equal dictionary "--exit--") (insert "(end of default search list)\n") - (link-insert-link (concat dictionary ": " translated) - 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (dictionary-link-insert-link (concat dictionary ": " translated) + 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -918,10 +918,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) (insert "Information on dictionary: ") - (link-insert-link description 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (dictionary-link-insert-link description 'dictionary-reference-face + 'dictionary-set-dictionary + (cons dictionary description) + "Mouse-2 to select this dictionary") (insert "\n\n") (setq reply (dictionary-read-answer)) (insert reply) @@ -969,9 +969,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (description (cadr list))) (if strategy (progn - (link-insert-link description 'dictionary-reference-face - 'dictionary-set-strategy strategy - "Mouse-2 to select this matching algorithm") + (dictionary-link-insert-link description 'dictionary-reference-face + 'dictionary-set-strategy strategy + "Mouse-2 to select this matching algorithm") (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) @@ -1071,11 +1071,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (link-insert-link word - 'dictionary-reference-face - 'dictionary-new-search - (cons word dictionary) - "Mouse-2 to lookup word") + (dictionary-link-insert-link word + 'dictionary-reference-face + 'dictionary-new-search + (cons word dictionary) + "Mouse-2 to lookup word") (insert "\n")) (reverse word-list)) (insert "\n"))) list)) @@ -1133,7 +1133,7 @@ It presents the word at point as default input and allows editing it." (defun dictionary-next-link () "Place the cursor to the next link." (interactive) - (let ((pos (link-next-link))) + (let ((pos (dictionary-link-next-link))) (if pos (goto-char pos) (error "There is no next link")))) @@ -1141,7 +1141,7 @@ It presents the word at point as default input and allows editing it." (defun dictionary-prev-link () "Place the cursor to the previous link." (interactive) - (let ((pos (link-prev-link))) + (let ((pos (dictionary-link-prev-link))) (if pos (goto-char pos) (error "There is no previous link")))) From 723906c4443e4aa8636c0d5bec8645ae1e29f79a Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 5 Oct 2020 07:06:30 +0200 Subject: [PATCH 004/148] Removed some compability parts in dictionary * lisp/net/dictionary.el: Use cl-lib, remove defface and defgroup checks, remove xemacs-related code * lisp/net/dictionary-link.el: Remove xemacs-related code --- lisp/net/dictionary-link.el | 12 ++-- lisp/net/dictionary.el | 126 +++++------------------------------- 2 files changed, 21 insertions(+), 117 deletions(-) diff --git a/lisp/net/dictionary-link.el b/lisp/net/dictionary-link.el index 86e853e64e6..549f199e02a 100644 --- a/lisp/net/dictionary-link.el +++ b/lisp/net/dictionary-link.el @@ -113,14 +113,10 @@ link. Upon clicking the `function' is called with `data' as argument." (defun dictionary-link-initialize-keymap (keymap) "Defines the necessary bindings inside keymap" - (if (and (boundp 'running-xemacs) running-xemacs) - (progn - (define-key keymap [button2] 'dictionary-link-mouse-click) - (define-key keymap [(meta button2)] 'dictionary-link-mouse-click-all)) - (define-key keymap [mouse-2] 'dictionary-link-mouse-click) - (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all)) - (define-key keymap "\r" 'dictionary-link-selected) - (define-key keymap "\M-\r" 'dictionary-link-selected-all)) + (define-key keymap [mouse-2] 'dictionary-link-mouse-click) + (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all) + (define-key keymap "\r" 'dictionary-link-selected) + (define-key keymap "\M-\r" 'dictionary-link-selected-all)) (provide 'dictionary-link) ;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 4b2f25c26b4..ef667f1fe35 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -34,9 +34,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'easymenu) (require 'custom) (require 'dictionary-connection) @@ -46,16 +44,6 @@ ;; Stuff for customizing. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-when-compile - (unless (fboundp 'defface) - (message "Please update your custom.el file: %s" - "http://www.dina.kvl.dk/~abraham/custom/")) - - (unless (fboundp 'defgroup) - (defmacro defgroup (&rest ignored)) - (defmacro defcustom (var value doc &rest ignored) - (list 'defvar var value doc)))) - (defvar dictionary-server) (defun dictionary-set-server-var (name value) (if (and (boundp 'dictionary-connection) @@ -351,7 +339,7 @@ by the choice value: " (unless (eq major-mode 'dictionary-mode) - (incf dictionary-instances)) + (cl-incf dictionary-instances)) (kill-all-local-variables) (buffer-disable-undo) @@ -370,8 +358,6 @@ by the choice value: (make-local-variable 'dictionary-default-dictionary) (make-local-variable 'dictionary-default-strategy) - (if (featurep 'xemacs) - (make-local-hook 'kill-buffer-hook)) (add-hook 'kill-buffer-hook 'dictionary-close t t) (run-hooks 'dictionary-mode-hook)) @@ -519,7 +505,7 @@ by the choice value: (if (eq major-mode 'dictionary-mode) (progn (setq major-mode nil) - (if (<= (decf dictionary-instances) 0) + (if (<= (cl-decf dictionary-instances) 0) (dictionary-connection-close dictionary-connection)) (let ((configuration dictionary-window-configuration) (selected-window dictionary-selected-window)) @@ -1210,8 +1196,6 @@ It presents the word at point as default input and allows editing it." ;;; Tooltip support -;; Common to GNU Emacs and XEmacs - ;; Add a mode indicater named "Dict" (defvar dictionary-tooltip-mode nil @@ -1235,79 +1219,6 @@ It presents the word at point as default input and allows editing it." (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (mapconcat 'identity (cdr list) "\n"))) -(defconst dictionary-use-balloon-help - (eval-when-compile - (condition-case nil - (require 'balloon-help) - (error nil)))) - -(make-variable-buffer-local 'dictionary-balloon-help-extent) - -(if dictionary-use-balloon-help - (progn - -;; The following definition are only valid for XEmacs with balloon-help - -(defvar dictionary-balloon-help-position nil - "Current position to lookup word") - -(defun dictionary-balloon-help-store-position (event) - (setq dictionary-balloon-help-position (event-point event))) - -(defun dictionary-balloon-help-description (&rest extent) - "Get the word from the cursor and lookup it" - (if dictionary-balloon-help-position - (let ((word (save-window-excursion - (save-excursion - (goto-char dictionary-balloon-help-position) - (current-word))))) - (let ((definition - (dictionary-definition word dictionary-tooltip-dictionary))) - (if definition - (dictionary-decode-charset definition - dictionary-tooltip-dictionary) - nil))))) - -(defvar dictionary-balloon-help-extent nil - "The extent for activating the balloon help") - -;;;###autoload -(defun dictionary-tooltip-mode (&optional arg) - "Display tooltips for the current word" - (interactive "P") - (let* ((on (if arg - (> (prefix-numeric-value arg) 0) - (not dictionary-tooltip-mode)))) - (make-local-variable 'dictionary-tooltip-mode) - (if on - ;; active mode - (progn - ;; remove old extend - (if dictionary-balloon-help-extent - (delete-extent dictionary-balloon-help-extent)) - ;; create new one - (setq dictionary-balloon-help-extent (make-extent (point-min) - (point-max))) - (set-extent-property dictionary-balloon-help-extent - 'balloon-help - 'dictionary-balloon-help-description) - (set-extent-property dictionary-balloon-help-extent - 'start-open nil) - (set-extent-property dictionary-balloon-help-extent - 'end-open nil) - (add-hook 'mouse-motion-hook - 'dictionary-balloon-help-store-position)) - - ;; deactivate mode - (if dictionary-balloon-help-extent - (delete-extent dictionary-balloon-help-extent)) - (remove-hook 'mouse-motion-hook - 'dictionary-balloon-help-store-position)) - (setq dictionary-tooltip-mode on) - (balloon-help-minor-mode on))) - -) ;; end of XEmacs part - (defvar global-dictionary-tooltip-mode nil) @@ -1317,16 +1228,16 @@ It presents the word at point as default input and allows editing it." (interactive "e") (if dictionary-tooltip-dictionary (let ((word (save-window-excursion - (save-excursion - (mouse-set-point event) - (current-word))))) - (let ((definition - (dictionary-definition word dictionary-tooltip-dictionary))) - (if definition - (tooltip-show - (dictionary-decode-charset definition - dictionary-tooltip-dictionary))) - t)) + (save-excursion + (mouse-set-point event) + (current-word))))) + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (tooltip-show + (dictionary-decode-charset definition + dictionary-tooltip-dictionary))) + t)) nil)) ;;;###autoload @@ -1335,8 +1246,8 @@ It presents the word at point as default input and allows editing it." (interactive "P") (require 'tooltip) (let ((on (if arg - (> (prefix-numeric-value arg) 0) - (not dictionary-tooltip-mode)))) + (> (prefix-numeric-value arg) 0) + (not dictionary-tooltip-mode)))) (make-local-variable 'dictionary-tooltip-mode) (setq dictionary-tooltip-mode on) ;; make sure that tooltip is still (global available) even is on @@ -1352,16 +1263,13 @@ It presents the word at point as default input and allows editing it." (interactive "P") (require 'tooltip) (let* ((on (if arg (> (prefix-numeric-value arg) 0) - (not global-dictionary-tooltip-mode))) - (hook-fn (if on 'add-hook 'remove-hook))) + (not global-dictionary-tooltip-mode))) + (hook-fn (if on 'add-hook 'remove-hook))) (setq global-dictionary-tooltip-mode on) (tooltip-mode 1) (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip) (setq-default dictionary-tooltip-mode on) (setq-default track-mouse on))) -) ;; end of GNU Emacs part - (provide 'dictionary) - ;;; dictionary.el ends here From 5dc17d73b071aefac3dcfed193a82601c94a98af Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 8 Oct 2020 19:30:12 +0200 Subject: [PATCH 005/148] Add :version tag to defcustom statement * lisp/net/dictionary.el: Add :version tag to all defcustom statements Suggested-By: Robert Pluim --- lisp/net/dictionary.el | 60 ++++++++++++++++++++++++++++-------------- 1 file changed, 40 insertions(+), 20 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index ef667f1fe35..7f4bb2a8282 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -67,7 +67,8 @@ "This server is contacted for searching the dictionary" :group 'dictionary :set 'dictionary-set-server-var - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-port 2628 @@ -75,13 +76,15 @@ This port is propably always 2628 so there should be no need to modify it." :group 'dictionary :set 'dictionary-set-server-var - :type 'number) + :type 'number + :version "28.1") (defcustom dictionary-identification "dictionary.el emacs lisp dictionary client" "This is the identification string that will be sent to the server." :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-default-dictionary "*" @@ -89,13 +92,15 @@ * and ! have a special meaning, * search all dictionaries, ! search until one dictionary yields matches." :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-default-strategy "." "The default strategy for listing matching words." :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-default-popup-strategy "exact" @@ -132,58 +137,67 @@ by the choice value: :type '(choice (const :tag "Exact match" "exact") (const :tag "Similiar sounding" "soundex") (const :tag "Levenshtein distance one" "lev") - (string :tag "User choice"))) + (string :tag "User choice")) + :version "28.1") (defcustom dictionary-create-buttons t "Create some clickable buttons on top of the window if non-nil." :group 'dictionary - :type 'boolean) + :type 'boolean + :version "28.1") (defcustom dictionary-mode-hook nil "Hook run in dictionary mode buffers." :group 'dictionary - :type 'hook) + :type 'hook + :version "28.1") (defcustom dictionary-use-http-proxy nil "Connects via a HTTP proxy using the CONNECT command when not nil." :group 'dictionary-proxy :set 'dictionary-set-server-var - :type 'boolean) + :type 'boolean + :version "28.1") (defcustom dictionary-proxy-server "proxy" "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." :group 'dictionary-proxy :set 'dictionary-set-server-var - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-proxy-port 3128 "The port of the proxy server, used only when dictionary-use-http-proxy is set." :group 'dictionary-proxy :set 'dictionary-set-server-var - :type 'number) + :type 'number + :version "28.1") (defcustom dictionary-use-single-buffer nil "Should the dictionary command reuse previous dictionary buffers?" :group 'dictionary - :type 'boolean) + :type 'boolean + :version "28.1") (defcustom dictionary-description-open-delimiter "" "The delimiter to display in front of the dictionaries description" :group 'dictionary - :type 'string) + :type 'string + :version "28.1") (defcustom dictionary-description-close-delimiter "" "The delimiter to display after of the dictionaries description" :group 'dictionary - :type 'string) + :type 'string + :version "28.1") ;; Define only when coding-system-list is available (when (fboundp 'coding-system-list) @@ -200,7 +214,8 @@ by the choice value: :value 'utf-8 ,@(mapcar (lambda (x) (list 'const x)) (coding-system-list)) - )))) + ))) + :version "28.1") ) @@ -215,7 +230,8 @@ by the choice value: (t (:font "default"))) "The face that is used for displaying the definition of the word." - :group 'dictionary) + :group 'dictionary + :version "28.1") (defface dictionary-word-entry-face '((((type x)) @@ -225,13 +241,15 @@ by the choice value: (t (:inverse t))) "The face that is used for displaying the initial word entry line." - :group 'dictionary) + :group 'dictionary + :version "28.1") (defface dictionary-button-face '((t (:bold t))) "The face that is used for displaying buttons." - :group 'dictionary) + :group 'dictionary + :version "28.1") (defface dictionary-reference-face '((((type x) @@ -249,7 +267,8 @@ by the choice value: (:underline t))) "The face that is used for displaying a reference word." - :group 'dictionary) + :group 'dictionary + :version "28.1") ) @@ -1206,7 +1225,8 @@ It presents the word at point as default input and allows editing it." nil "This dictionary to lookup words for tooltips" :group 'dictionary - :type '(choice (const :tag "None" nil) string)) + :type '(choice (const :tag "None" nil) string) + :version "28.1") (defun dictionary-definition (word &optional dictionary) (interactive) From 49c250b388eac27221caa460a01d4ed43c0b37a6 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 8 Oct 2020 19:33:33 +0200 Subject: [PATCH 006/148] Dont't check coding-system-list for existence * lisp/net/dictionary.el (dictionary-coding-systems-for-dictionaries): Don't check for coding-system-list before using it. It check no longer be necessary. --- lisp/net/dictionary.el | 51 +++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 28 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7f4bb2a8282..6ba1cc27751 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -200,24 +200,21 @@ by the choice value: :version "28.1") ;; Define only when coding-system-list is available -(when (fboundp 'coding-system-list) - (defcustom dictionary-coding-systems-for-dictionaries - '( ("mueller" . koi8-r)) - "Mapping of dictionaries to coding systems. - Each entry in this list defines the coding system to be used for that - dictionary. The default coding system for all other dictionaries - is utf-8" - :group 'dictionary - :type `(repeat (cons :tag "Association" - (string :tag "Dictionary name") - (choice :tag "Coding system" - :value 'utf-8 - ,@(mapcar (lambda (x) (list 'const x)) - (coding-system-list)) - ))) - :version "28.1") - - ) +(defcustom dictionary-coding-systems-for-dictionaries + '( ("mueller" . koi8-r)) + "Mapping of dictionaries to coding systems. +Each entry in this list defines the coding system to be used for that +dictionary. The default coding system for all other dictionaries +is utf-8" + :group 'dictionary + :type `(repeat (cons :tag "Association" + (string :tag "Dictionary name") + (choice :tag "Coding system" + :value 'utf-8 + ,@(mapcar (lambda (x) (list 'const x)) + (coding-system-list)) + ))) + :version "28.1") (if (fboundp 'defface) (progn @@ -459,8 +456,7 @@ by the choice value: (eq (dictionary-connection-status dictionary-connection) 'up))) (let ((wanted 'raw-text) (coding-system nil)) - (if (and (fboundp 'coding-system-list) - (member wanted (coding-system-list))) + (if (member wanted (coding-system-list)) (setq coding-system wanted)) (let ((coding-system-for-read coding-system) (coding-system-for-write coding-system)) @@ -597,14 +593,13 @@ This function knows about the special meaning of quotes (\")" (defun dictionary-coding-system (dictionary) "Select coding system to use for that dictionary" - (when (boundp 'dictionary-coding-systems-for-dictionaries) - (let ((coding-system - (or (cdr (assoc dictionary - dictionary-coding-systems-for-dictionaries)) - 'utf-8))) - (if (member coding-system (coding-system-list)) - coding-system - nil)))) + (let ((coding-system + (or (cdr (assoc dictionary + dictionary-coding-systems-for-dictionaries)) + 'utf-8))) + (if (member coding-system (coding-system-list)) + coding-system + nil))) (defun dictionary-decode-charset (text dictionary) "Convert the text from the charset defined by the dictionary given." From 99a7e918c82c0d5c39a729668ac582a945877900 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 8 Oct 2020 19:35:50 +0200 Subject: [PATCH 007/148] Don't check for existence of defface * lisp/net/dictionary.el: defface has been available in Emacs for quite some time now. No need to check it before using it. --- lisp/net/dictionary.el | 97 +++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 54 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 6ba1cc27751..a0e43b89d96 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -216,64 +216,53 @@ is utf-8" ))) :version "28.1") -(if (fboundp 'defface) - (progn +(defface dictionary-word-definition-face +'((((supports (:family "DejaVu Serif"))) + (:family "DejaVu Serif")) + (((type x)) + (:font "Sans Serif")) + (t + (:font "default"))) +"The face that is used for displaying the definition of the word." +:group 'dictionary +:version "28.1") - (defface dictionary-word-definition-face - '((((supports (:family "DejaVu Serif"))) - (:family "DejaVu Serif")) - (((type x)) - (:font "Sans Serif")) - (t - (:font "default"))) - "The face that is used for displaying the definition of the word." - :group 'dictionary - :version "28.1") +(defface dictionary-word-entry-face + '((((type x)) + (:italic t)) + (((type tty) (class color)) + (:foreground "green")) + (t + (:inverse t))) + "The face that is used for displaying the initial word entry line." + :group 'dictionary + :version "28.1") - (defface dictionary-word-entry-face - '((((type x)) - (:italic t)) - (((type tty) (class color)) - (:foreground "green")) - (t - (:inverse t))) - "The face that is used for displaying the initial word entry line." - :group 'dictionary - :version "28.1") +(defface dictionary-button-face + '((t + (:bold t))) + "The face that is used for displaying buttons." + :group 'dictionary + :version "28.1") - (defface dictionary-button-face - '((t - (:bold t))) - "The face that is used for displaying buttons." - :group 'dictionary - :version "28.1") +(defface dictionary-reference-face + '((((type x) + (class color) + (background dark)) + (:foreground "yellow")) + (((type tty) + (class color) + (background dark)) + (:foreground "cyan")) + (((class color) + (background light)) + (:foreground "blue")) + (t + (:underline t))) - (defface dictionary-reference-face - '((((type x) - (class color) - (background dark)) - (:foreground "yellow")) - (((type tty) - (class color) - (background dark)) - (:foreground "cyan")) - (((class color) - (background light)) - (:foreground "blue")) - (t - (:underline t))) - - "The face that is used for displaying a reference word." - :group 'dictionary - :version "28.1") - - ) - - ;; else - (copy-face 'italic 'dictionary-word-entry-face) - (copy-face 'bold 'dictionary-button-face) - (copy-face 'default 'dictionary-reference-face) - (set-face-foreground 'dictionary-reference-face "blue")) + "The face that is used for displaying a reference word." + :group 'dictionary + :version "28.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Buffer local variables for storing the current state From 1773b9b68742c95b1648a90c56eb7b56c77db591 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Fri, 9 Oct 2020 05:00:02 +0200 Subject: [PATCH 008/148] Dictionary now uses button * net/lisp/dictionary-link.el: Removed now obsolete file * net/lisp/dictionary.el: Use insert-button and make-button * net/lisp/dictionary.el (dictionary-mode-map): Now defined using defvar I had to add a conversion function as parameter for the button 'action as I need to be able to pass nil data to my function. This is not possible with the regular button 'action function and the 'button-data value. The functionality of searching a link in all dictionaries has been removed for now. It might appear again once I have an idea how to implement it. --- lisp/net/dictionary-link.el | 122 --------------------------- lisp/net/dictionary.el | 163 +++++++++++++++--------------------- 2 files changed, 67 insertions(+), 218 deletions(-) delete mode 100644 lisp/net/dictionary-link.el diff --git a/lisp/net/dictionary-link.el b/lisp/net/dictionary-link.el deleted file mode 100644 index 549f199e02a..00000000000 --- a/lisp/net/dictionary-link.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; dictionary-link.el --- Hypertext links in text buffers - -;; Author: Torsten Hilbrich -;; Keywords: interface, hypermedia -;; Version: 1.11 - -;; 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 -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This file 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file contains functions for using links in buffers. A link is -;; a part of the buffer marked with a special face, beeing -;; hightlighted while the mouse points to it and beeing activated when -;; pressing return or clicking the button2. - -;; Which each link a function and some data are associated. Upon -;; clicking the function is called with the data as only -;; argument. Both the function and the data are stored in text -;; properties. -;; -;; dictionary-link-create-link - insert a new link for the text in the given range -;; dictionary-link-initialize-keymap - install the keybinding for selecting links - -;;; Code: - -(defun dictionary-link-create-link (start end face function &optional data help) - "Create a link in the current buffer starting from `start' going to `end'. -The `face' is used for displaying, the `data' are stored together with the -link. Upon clicking the `function' is called with `data' as argument." - (let ((properties `(face ,face - mouse-face highlight - link t - link-data ,data - help-echo ,help - link-function ,function))) - (remove-text-properties start end properties) - (add-text-properties start end properties))) - -(defun dictionary-link-insert-link (text face function &optional data help) - "Insert the `text' at point to be formatted as link. -The `face' is used for displaying, the `data' are stored together with the -link. Upon clicking the `function' is called with `data' as argument." - (let ((start (point))) - (insert text) - (dictionary-link-create-link start (point) face function data help))) - -(defun dictionary-link-selected (&optional all) - "Is called upon clicking or otherwise visiting the link." - (interactive) - - (let* ((properties (text-properties-at (point))) - (function (plist-get properties 'link-function)) - (data (plist-get properties 'link-data))) - (if function - (funcall function data all)))) - -(defun dictionary-link-selected-all () - "Called for meta clicking the link" - (interactive) - (dictionary-link-selected 'all)) - -(defun dictionary-link-mouse-click (event &optional all) - "Is called upon clicking the link." - (interactive "@e") - - (mouse-set-point event) - (dictionary-link-selected)) - -(defun dictionary-link-mouse-click-all (event) - "Is called upon meta clicking the link." - (interactive "@e") - - (mouse-set-point event) - (dictionary-link-selected-all)) - -(defun dictionary-link-next-link () - "Return the position of the next link or nil if there is none" - (let* ((pos (point)) - (pos (next-single-property-change pos 'link))) - (if pos - (if (text-property-any pos (min (1+ pos) (point-max)) 'link t) - pos - (next-single-property-change pos 'link)) - nil))) - - -(defun dictionary-link-prev-link () - "Return the position of the previous link or nil if there is none" - (let* ((pos (point)) - (pos (previous-single-property-change pos 'link))) - (if pos - (if (text-property-any pos (1+ pos) 'link t) - pos - (let ((val (previous-single-property-change pos 'link))) - (if val - val - (text-property-any (point-min) (1+ (point-min)) 'link t)))) - nil))) - -(defun dictionary-link-initialize-keymap (keymap) - "Defines the necessary bindings inside keymap" - - (define-key keymap [mouse-2] 'dictionary-link-mouse-click) - (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all) - (define-key keymap "\r" 'dictionary-link-selected) - (define-key keymap "\M-\r" 'dictionary-link-selected-all)) - -(provide 'dictionary-link) -;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index a0e43b89d96..b25dda5c69c 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -38,7 +38,7 @@ (require 'easymenu) (require 'custom) (require 'dictionary-connection) -(require 'dictionary-link) +(require 'button) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -296,8 +296,24 @@ is utf-8" ;; Global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar dictionary-mode-map - nil - "Keymap for dictionary mode") + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + + (define-key map "q" 'dictionary-close) + (define-key map "h" 'dictionary-help) + (define-key map "s" 'dictionary-search) + (define-key map "d" 'dictionary-lookup-definition) + (define-key map "D" 'dictionary-select-dictionary) + (define-key map "M" 'dictionary-select-strategy) + (define-key map "m" 'dictionary-match-words) + (define-key map "l" 'dictionary-previous) + (define-key map "n" 'forward-button) + (define-key map "p" 'backward-button) + (define-key map " " 'scroll-up) + (define-key map (read-kbd-macro "M-SPC") 'scroll-down) + map) + "Keymap for the dictionary mode.") (defvar dictionary-connection nil @@ -340,7 +356,6 @@ is utf-8" * M select the default search strategy * Return or Button2 visit that link - * M-Return or M-Button2 search the word beneath link in all dictionaries " (unless (eq major-mode 'dictionary-mode) @@ -394,39 +409,6 @@ is utf-8" (dictionary-pre-buffer) (dictionary-post-buffer)) - -(unless dictionary-mode-map - (setq dictionary-mode-map (make-sparse-keymap)) - (suppress-keymap dictionary-mode-map) - - (define-key dictionary-mode-map "q" 'dictionary-close) - (define-key dictionary-mode-map "h" 'dictionary-help) - (define-key dictionary-mode-map "s" 'dictionary-search) - (define-key dictionary-mode-map "d" 'dictionary-lookup-definition) - (define-key dictionary-mode-map "D" 'dictionary-select-dictionary) - (define-key dictionary-mode-map "M" 'dictionary-select-strategy) - (define-key dictionary-mode-map "m" 'dictionary-match-words) - (define-key dictionary-mode-map "l" 'dictionary-previous) - - (if (and (string-match "GNU" (emacs-version)) - (not window-system)) - (define-key dictionary-mode-map [9] 'dictionary-next-link) - (define-key dictionary-mode-map [tab] 'dictionary-next-link)) - - ;; shift-tabs normally is supported on window systems only, but - ;; I do not enforce it - (define-key dictionary-mode-map [(shift tab)] 'dictionary-prev-link) - (define-key dictionary-mode-map "\e\t" 'dictionary-prev-link) - (define-key dictionary-mode-map [backtab] 'dictionary-prev-link) - - (define-key dictionary-mode-map "n" 'dictionary-next-link) - (define-key dictionary-mode-map "p" 'dictionary-prev-link) - - (define-key dictionary-mode-map " " 'scroll-up) - (define-key dictionary-mode-map [(meta space)] 'scroll-down) - - (dictionary-link-initialize-keymap dictionary-mode-map)) - (defmacro dictionary-reply-code (reply) "Return the reply code stored in `reply'." (list 'get reply ''reply-code)) @@ -696,43 +678,48 @@ This function knows about the special meaning of quotes (\")" (error "Unknown server answer: %s" (dictionary-reply reply))) (funcall function reply))))) +(define-button-type 'dictionary-link + 'face 'dictionary-reference-face + 'action (lambda (button) (funcall (button-get button 'callback) + (button-get button 'data)))) + +(define-button-type 'dictionary-button + :supertype 'dictionary-link + 'face 'dictionary-button-face) + (defun dictionary-pre-buffer () "These commands are executed at the begin of a new buffer" (setq buffer-read-only nil) (erase-buffer) (if dictionary-create-buttons (progn - (dictionary-link-insert-link "[Back]" 'dictionary-button-face - 'dictionary-restore-state nil - "Mouse-2 to go backwards in history") + (insert-button "[Back]" :type 'dictionary-button + 'callback 'dictionary-restore-state + 'help-echo (purecopy "Mouse-2 to go backwards in history")) (insert " ") - (dictionary-link-insert-link "[Search Definition]" - 'dictionary-button-face - 'dictionary-search nil - "Mouse-2 to look up a new word") + (insert-button "[Search Definition]" :type 'dictionary-button + 'callback 'dictionary-search + 'help-echo (purecopy "Mouse-2 to look up a new word")) (insert " ") - (dictionary-link-insert-link "[Matching words]" - 'dictionary-button-face - 'dictionary-match-words nil - "Mouse-2 to find matches for a pattern") + (insert-button "[Matching words]" :type 'dictionary-button + 'callback 'dictionary-match-words + 'help-echo (purecopy "Mouse-2 to find matches for a pattern")) (insert " ") - (dictionary-link-insert-link "[Quit]" 'dictionary-button-face - 'dictionary-close nil - "Mouse-2 to close this window") + (insert-button "[Quit]" :type 'dictionary-button + 'callback 'dictionary-close + 'help-echo (purecopy "Mouse-2 to close this window")) (insert "\n ") - (dictionary-link-insert-link "[Select Dictionary]" - 'dictionary-button-face - 'dictionary-select-dictionary nil - "Mouse-2 to select dictionary for future searches") + (insert-button "[Select Dictionary]" :type 'dictionary-button + 'callback 'dictionary-select-dictionary + 'help-echo (purecopy "Mouse-2 to select dictionary for future searches")) (insert " ") - (dictionary-link-insert-link "[Select Match Strategy]" - 'dictionary-button-face - 'dictionary-select-strategy nil - "Mouse-2 to select matching algorithm") + (insert-button "[Select Match Strategy]" :type 'dictionary-button + 'callback 'dictionary-select-strategy + 'help-echo (purecopy "Mouse-2 to select matching algorithm")) (insert "\n\n"))) (setq dictionary-marker (point-marker))) @@ -810,10 +797,11 @@ The word is taken from the buffer, the `dictionary' is given as argument." (setq word (replace-match "" t t word))) (unless (equal word displayed-word) - (dictionary-link-create-link start end 'dictionary-reference-face - call (cons word dictionary) - (concat "Press Mouse-2 to lookup \"" - word "\" in \"" dictionary "\""))))) + (make-button start end :type 'dictionary-link + 'callback call + 'data (cons word dictionary) + 'help-echo (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) "Save the current state and start a dictionary selection" @@ -871,11 +859,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if dictionary (if (equal dictionary "--exit--") (insert "(end of default search list)\n") - (dictionary-link-insert-link (concat dictionary ": " translated) - 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (insert-button (concat dictionary ": " translated) :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'data (cons dictionary description) + 'help-echo (purecopy "Mouse-2 to select this dictionary")) (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -907,10 +894,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) (insert "Information on dictionary: ") - (dictionary-link-insert-link description 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (insert-button description :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'data (cons dictionary description) + 'help-echo (purecopy "Mouse-2 to select this dictionary")) (insert "\n\n") (setq reply (dictionary-read-answer)) (insert reply) @@ -958,9 +945,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (description (cadr list))) (if strategy (progn - (dictionary-link-insert-link description 'dictionary-reference-face - 'dictionary-set-strategy strategy - "Mouse-2 to select this matching algorithm") + (insert-button description :type 'dictionary-link + 'callback 'dictionary-set-strategy + 'data strategy + 'help-echo (purecopy "Mouse-2 to select this matching algorithm")) (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) @@ -1060,11 +1048,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (dictionary-link-insert-link word - 'dictionary-reference-face - 'dictionary-new-search - (cons word dictionary) - "Mouse-2 to lookup word") + (insert-button word :type 'dictionary-button + 'callback 'dictionary-new-search + 'data (cons word dictionary) + 'help-echo (purecopy "Mouse-2 to lookup word")) (insert "\n")) (reverse word-list)) (insert "\n"))) list)) @@ -1119,22 +1106,6 @@ It presents the word at point as default input and allows editing it." (error "Current buffer is no dictionary buffer")) (dictionary-restore-state)) -(defun dictionary-next-link () - "Place the cursor to the next link." - (interactive) - (let ((pos (dictionary-link-next-link))) - (if pos - (goto-char pos) - (error "There is no next link")))) - -(defun dictionary-prev-link () - "Place the cursor to the previous link." - (interactive) - (let ((pos (dictionary-link-prev-link))) - (if pos - (goto-char pos) - (error "There is no previous link")))) - (defun dictionary-help () "Display a little help" (interactive) From 329b6a0210f28d8abf8a8ce7afa6a7a6d3f84977 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Fri, 9 Oct 2020 06:04:35 +0200 Subject: [PATCH 009/148] Adding details page for dictionary * net/lisp/dictionary.el (dictionary-display-dictionary-line): Allow getting more details on a dictionary by clicking the "(Details)" link. I had the functionality to query the dictionary information but no mechanism to invoke it. So just add a button after the short description of the dictionary to get more information. --- lisp/net/dictionary.el | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index b25dda5c69c..c852f6cfdc7 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -680,8 +680,13 @@ This function knows about the special meaning of quotes (\")" (define-button-type 'dictionary-link 'face 'dictionary-reference-face - 'action (lambda (button) (funcall (button-get button 'callback) - (button-get button 'data)))) + 'action (lambda (button) + (let ((func (button-get button 'callback)) + (data (button-get button 'data)) + (list-data (button-get button 'list-data))) + (if list-data + (apply func list-data) + (funcall func data))))) (define-button-type 'dictionary-button :supertype 'dictionary-link @@ -863,6 +868,12 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." 'callback 'dictionary-set-dictionary 'data (cons dictionary description) 'help-echo (purecopy "Mouse-2 to select this dictionary")) + (unless (dictionary-special-dictionary dictionary) + (insert " ") + (insert-button "(Details)" :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'list-data (list (cons dictionary description) t) + 'help-echo (purecopy "Mouse-2 to get more information"))) (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -875,13 +886,17 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-restore-state) (message "Dictionary %s has been selected" dictionary)))) +(defun dictionary-special-dictionary (name) + "Checks whether the special * or ! dictionary are seen" + (or (equal name "*") + (equal name "!"))) + (defun dictionary-display-more-info (param) "Display the available information on the dictionary" (let ((dictionary (car param)) (description (cdr param))) - (unless (or (equal dictionary "*") - (equal dictionary "!")) + (unless (dictionary-special-dictionary dictionary) (dictionary-store-positions) (message "Requesting more information on %s" dictionary) (dictionary-send-command @@ -1048,7 +1063,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (insert-button word :type 'dictionary-button + (insert-button word :type 'dictionary-link 'callback 'dictionary-new-search 'data (cons word dictionary) 'help-echo (purecopy "Mouse-2 to lookup word")) From 837505075c942183cac004cb8fa0c0e57c82535d Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Sat, 10 Oct 2020 07:04:27 +0200 Subject: [PATCH 010/148] Fix dictionary tooltip mode * lisp/net/dicionary.el (dictionary-tooltip-mode): Add mouse movement binding and use tooltip-functions instead of tooltip-hook There were some changes in Emacs since testing it the last time. I had to add keybinding for mouse movement and enable track-mouse to get the mode working again. --- lisp/net/dictionary.el | 103 ++++++++++++++++++++++++++++++----------- 1 file changed, 77 insertions(+), 26 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index c852f6cfdc7..8d7d97afe0e 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1209,30 +1209,69 @@ It presents the word at point as default input and allows editing it." (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (mapconcat 'identity (cdr list) "\n"))) +;;; Tooltip support for GNU Emacs (defvar global-dictionary-tooltip-mode nil) -;;; Tooltip support for GNU Emacs +(defun dictionary-word-at-mouse-event (event) + (with-current-buffer (tooltip-event-buffer event) + (let ((point (posn-point (event-end event)))) + (if (use-region-p) + (when (and (<= (region-beginning) point) (<= point (region-end))) + (buffer-substring (region-beginning) (region-end))) + (save-excursion + (goto-char point) + (current-word)))))) + (defun dictionary-display-tooltip (event) "Search the current word in the `dictionary-tooltip-dictionary'." (interactive "e") - (if dictionary-tooltip-dictionary - (let ((word (save-window-excursion - (save-excursion - (mouse-set-point event) - (current-word))))) - (let ((definition - (dictionary-definition word dictionary-tooltip-dictionary))) - (if definition - (tooltip-show - (dictionary-decode-charset definition - dictionary-tooltip-dictionary))) - t)) + (if (and dictionary-tooltip-mode dictionary-tooltip-dictionary) + (let ((word (dictionary-word-at-mouse-event dictionary-tooltip-mouse-event))) + (if word + (let ((definition + (dictionary-definition word dictionary-tooltip-dictionary))) + (if definition + (tooltip-show (dictionary-decode-charset definition + dictionary-tooltip-dictionary))))) + t) nil)) +(defvar dictionary-tooltip-mouse-event nil + "Event that triggered the tooltip mode") + +(defun dictionary-tooltip-track-mouse (event) + "Called whenever a dictionary tooltip display is about to be triggered." + (interactive "e") + (tooltip-hide) + (when dictionary-tooltip-mode + (setq dictionary-tooltip-mouse-event (copy-sequence event)) + (tooltip-start-delayed-tip))) + +(defun dictionary-switch-tooltip-mode (on) + "Turn off or on support for the dictionary tooltip mode. + +It is normally internally called with 1 to enable support for the +tooltip mode. The hook function will check the value of the +variable dictionary-tooltip-mode to decide if some action must be +taken. When disabling the tooltip mode the value of this variable +will be set to nil. +" + (interactive) + (tooltip-mode on) + (if on + (add-hook 'tooltip-functions 'dictionary-display-tooltip) + (remove-hook 'tooltip-functions 'dictionary-display-tooltip))) + ;;;###autoload (defun dictionary-tooltip-mode (&optional arg) - "Display tooltips for the current word" + "Display tooltips for the current word. + +This function can be used to enable or disable the tooltip mode +for the current buffer. If global-tooltip-mode is active it will +overwrite that mode for the current buffer. +" + (interactive "P") (require 'tooltip) (let ((on (if arg @@ -1240,26 +1279,38 @@ It presents the word at point as default input and allows editing it." (not dictionary-tooltip-mode)))) (make-local-variable 'dictionary-tooltip-mode) (setq dictionary-tooltip-mode on) - ;; make sure that tooltip is still (global available) even is on - ;; if nil - (tooltip-mode 1) - (add-hook 'tooltip-hook 'dictionary-display-tooltip) (make-local-variable 'track-mouse) - (setq track-mouse on))) + (make-local-variable 'dictionary-tooltip-mouse-event) + (setq track-mouse on) + (dictionary-switch-tooltip-mode 1) + (if on + (local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse) + (local-set-key [mouse-movement] 'ignore)) + on)) ;;;###autoload (defun global-dictionary-tooltip-mode (&optional arg) - "Enable/disable dictionary-tooltip-mode for all buffers" + "Enable/disable dictionary-tooltip-mode for all buffers. + +Internally it provides a default for the dictionary-tooltip-mode. +It can be overwritten for each buffer using dictionary-tooltip-mode. + +Note: (global-dictionary-tooltip-mode 0) will not disable the mode +any buffer where (dictionary-tooltip-mode 1) has been called. +" (interactive "P") (require 'tooltip) - (let* ((on (if arg (> (prefix-numeric-value arg) 0) - (not global-dictionary-tooltip-mode))) - (hook-fn (if on 'add-hook 'remove-hook))) + (let ((on (if arg (> (prefix-numeric-value arg) 0) + (not global-dictionary-tooltip-mode)))) (setq global-dictionary-tooltip-mode on) - (tooltip-mode 1) - (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip) (setq-default dictionary-tooltip-mode on) - (setq-default track-mouse on))) + (make-local-variable 'dictionary-tooltip-mouse-event) + (setq-default track-mouse on) + (dictionary-switch-tooltip-mode 1) + (if on + (global-set-key [mouse-movement] 'dictionary-tooltip-track-mouse) + (global-set-key [mouse-movement] 'ignore)) + on)) (provide 'dictionary) ;;; dictionary.el ends here From 2f1e4fbc426624420159026b758c90a923a9b560 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 08:23:07 +0100 Subject: [PATCH 011/148] Support nil value for dictionary-server * net/lisp/dictionary.el (dictionary-server): Support choice to select the dictionary server to use * net/lisp/dictionary.el (dictionary-check-connection): Support nil value for dictionary-server This nil value is the new default value of that variable. When opening a new connection and dictionary-server is nil the code behaves the following way: - it will first try to connect to a dictd server running on localhost - if that fails, it queries the user if the alternative server (dict.org) should be consulted - if the user agrees, the connection is made to dict.org This allows the default value of dictionary-server not to connect a remote server by default. The user is always able to select a different server by customizing the variable dictionary-search. --- lisp/net/dictionary.el | 128 +++++++++++++++++++++++++---------------- 1 file changed, 77 insertions(+), 51 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 8d7d97afe0e..a1d4ac9214e 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -44,13 +44,13 @@ ;; Stuff for customizing. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar dictionary-server) +(defvar dictionary-current-server) (defun dictionary-set-server-var (name value) (if (and (boundp 'dictionary-connection) dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up) (y-or-n-p - (concat "Close existing connection to " dictionary-server "? "))) + (concat "Close existing connection to " dictionary-current-server "? "))) (dictionary-connection-close dictionary-connection)) (set-default name value)) @@ -63,11 +63,22 @@ :group 'dictionary) (defcustom dictionary-server - "dict.org" - "This server is contacted for searching the dictionary" + nil + "This server is contacted for searching the dictionary. + +You can specify here: + +- Automatic: First try localhost, then dict.org after confirmation +- localhost: Only use localhost +- dict.org: Only use dict.org +- User-defined: You can specify your own server here +" :group 'dictionary :set 'dictionary-set-server-var - :type 'string + :type '(choice (const :tag "Automatic" nil) + (const :tag "localhost" "localhost") + (const :tag "dict.org" "dict.org") + (string :tag "User-defined")) :version "28.1") (defcustom dictionary-port @@ -421,56 +432,71 @@ is utf-8" "Return the reply list stored in `reply'." (list 'get reply ''reply-list)) +(defun dictionary-open-server (server) + "Opens a new connection to this server" + (let ((wanted 'raw-text) + (coding-system nil)) + (if (member wanted (coding-system-list)) + (setq coding-system wanted)) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system)) + (setq dictionary-current-server server) + (message "Opening connection to %s:%s" server + dictionary-port) + (dictionary-connection-close dictionary-connection) + (setq dictionary-connection + (if dictionary-use-http-proxy + (dictionary-connection-open dictionary-proxy-server + dictionary-proxy-port) + (dictionary-connection-open server dictionary-port))) + (set-process-query-on-exit-flag + (dictionary-connection-process dictionary-connection) + nil) + + (when dictionary-use-http-proxy + (message "Proxy CONNECT to %s:%d" + dictionary-proxy-server + dictionary-proxy-port) + (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1" + server + dictionary-port)) + ;; just a \r\n combination + (dictionary-send-command "") + + ;; read first line of reply + (let* ((reply (dictionary-read-reply)) + (reply-list (dictionary-split-string reply))) + ;; first item is protocol, second item is code + (unless (= (string-to-number (cadr reply-list)) 200) + (error "Bad reply from proxy server %s" reply)) + + ;; skip the following header lines until empty found + (while (not (equal reply "")) + (setq reply (dictionary-read-reply))))) + + (dictionary-check-initial-reply) + (dictionary-send-command (concat "client " dictionary-identification)) + (let ((reply (dictionary-read-reply-and-split))) + (message nil) + (unless (dictionary-check-reply reply 250) + (error "Unknown server answer: %s" + (dictionary-reply reply))))))) + (defun dictionary-check-connection () "Check if there is already a connection open" (if (not (and dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up))) - (let ((wanted 'raw-text) - (coding-system nil)) - (if (member wanted (coding-system-list)) - (setq coding-system wanted)) - (let ((coding-system-for-read coding-system) - (coding-system-for-write coding-system)) - (message "Opening connection to %s:%s" dictionary-server - dictionary-port) - (dictionary-connection-close dictionary-connection) - (setq dictionary-connection - (if dictionary-use-http-proxy - (dictionary-connection-open dictionary-proxy-server - dictionary-proxy-port) - (dictionary-connection-open dictionary-server dictionary-port))) - (set-process-query-on-exit-flag - (dictionary-connection-process dictionary-connection) - nil) - - (when dictionary-use-http-proxy - (message "Proxy CONNECT to %s:%d" - dictionary-proxy-server - dictionary-proxy-port) - (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1" - dictionary-server - dictionary-port)) - ;; just a \r\n combination - (dictionary-send-command "") - - ;; read first line of reply - (let* ((reply (dictionary-read-reply)) - (reply-list (dictionary-split-string reply))) - ;; first item is protocol, second item is code - (unless (= (string-to-number (cadr reply-list)) 200) - (error "Bad reply from proxy server %s" reply)) - - ;; skip the following header lines until empty found - (while (not (equal reply "")) - (setq reply (dictionary-read-reply))))) - - (dictionary-check-initial-reply) - (dictionary-send-command (concat "client " dictionary-identification)) - (let ((reply (dictionary-read-reply-and-split))) - (message nil) - (unless (dictionary-check-reply reply 250) - (error "Unknown server answer: %s" - (dictionary-reply reply)))))))) + (if dictionary-server + (dictionary-open-server dictionary-server) + (let ((server "localhost")) + (condition-case nil + (dictionary-open-server server) + (error + (if (y-or-n-p + (format "Failed to open server %s, continue with dict.org?" + server)) + (dictionary-open-server "dict.org") + (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () "Return non-nil if current buffer has dictionary-mode" From 91ff1c8f7cf5b137b214b0b70a7267d34c1f6b36 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 08:25:42 +0100 Subject: [PATCH 012/148] Move placement of dictionary-tooltip-mouse-event * lisp/net/dictionary.el (dictionary-tooltip-mouse-event): Place variable before dictionary-display-tooltip to avoid warning about use of free variable when compiling dictionary-display-tooltip --- lisp/net/dictionary.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index a1d4ac9214e..1e1d4d9d444 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1249,6 +1249,9 @@ It presents the word at point as default input and allows editing it." (goto-char point) (current-word)))))) +(defvar dictionary-tooltip-mouse-event nil + "Event that triggered the tooltip mode") + (defun dictionary-display-tooltip (event) "Search the current word in the `dictionary-tooltip-dictionary'." (interactive "e") @@ -1263,9 +1266,6 @@ It presents the word at point as default input and allows editing it." t) nil)) -(defvar dictionary-tooltip-mouse-event nil - "Event that triggered the tooltip mode") - (defun dictionary-tooltip-track-mouse (event) "Called whenever a dictionary tooltip display is about to be triggered." (interactive "e") From 28fe1349711e36bd65542472cd3fb0d94c5e2bb2 Mon Sep 17 00:00:00 2001 From: Matthias Meulien Date: Sun, 8 Nov 2020 16:06:02 +0100 Subject: [PATCH 013/148] Remove text property from empty line --- lisp/net/dictionary.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1e1d4d9d444..0682d5511c9 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -788,9 +788,9 @@ This function knows about the special meaning of quotes (\")" dictionary-description-open-delimiter (dictionary-decode-charset description dictionary) dictionary-description-close-delimiter - " [" (dictionary-decode-charset dictionary dictionary) "]:" - "\n\n") - (put-text-property start (point) 'face 'dictionary-word-entry-face))) + " [" (dictionary-decode-charset dictionary dictionary) "]:") + (put-text-property start (point) 'face 'dictionary-word-entry-face) + (insert "\n\n"))) (defun dictionary-display-word-definition (reply word dictionary) "Insert the definition for the current word" From 7ca331a4f94a6a5f9c454823fd5c765031ce7167 Mon Sep 17 00:00:00 2001 From: Matthias Meulien Date: Sun, 8 Nov 2020 16:08:07 +0100 Subject: [PATCH 014/148] Add history of search words to read-string --- lisp/net/dictionary.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 0682d5511c9..510a905aca9 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -344,6 +344,10 @@ is utf-8" (error nil)) "Determines if the Emacs has support to display color") +(defvar dictionary-word-history + '() + "History list of searched word") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1118,7 +1122,7 @@ It presents the word at point as default input and allows editing it." (read-string (if default (format "Search word (%s): " default) "Search word: ") - nil nil default)) + nil 'dictionary-word-history default)) (if current-prefix-arg (read-string (if dictionary-default-dictionary (format "Dictionary (%s): " dictionary-default-dictionary) @@ -1128,7 +1132,7 @@ It presents the word at point as default input and allows editing it." ;; if called by pressing the button (unless word - (setq word (read-string "Search word: "))) + (setq word (read-string "Search word: " nil 'dictionary-word-history))) ;; just in case non-interactivly called (unless dictionary (setq dictionary dictionary-default-dictionary)) @@ -1158,7 +1162,8 @@ It presents the word at point as default input and allows editing it." (interactive) ;; can't use interactive because of mouse events (or pattern - (setq pattern (read-string "Search pattern: "))) + (setq pattern (read-string "Search pattern: " + nil 'dictionary-word-history))) (dictionary-new-matching pattern)) ;;;###autoload From d5a4da25b03d9af850077cf803b8099a4056152c Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:21:43 +0100 Subject: [PATCH 015/148] * lisp/net/dictionary.el: Remove remnants of package Version and package depedencies are not useful when included into Emacs. --- lisp/net/dictionary.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 510a905aca9..6eb8475f55d 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -2,8 +2,6 @@ ;; Author: Torsten Hilbrich ;; Keywords: interface, dictionary -;; Version: 1.11 -;; Package-Requires: ((connection "1.11") (link "1.11")) ;; 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 From de032d41c6c9dc143a5d2ddcacdccd20567aee8c Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Fri, 11 Dec 2020 10:24:58 +0100 Subject: [PATCH 016/148] Bind k to image-kill-buffer in doc-view-mode-map. * lisp/doc-view.el (doc-view-mode-map): Bind k to image-kill-buffer. The binding k -> doc-view-kill-proc-and-buffer has been removed in 2015 and the function been made an obsolete function alias to image-kill-buffer (bug#45157). --- lisp/doc-view.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index b895377f8dc..031e46a1c9d 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -432,6 +432,7 @@ Typically \"page-%s.png\".") (define-key map "P" 'doc-view-fit-page-to-window) (define-key map "F" 'doc-view-fit-window-to-page) ;F = frame ;; Killing the buffer (and the process) + (define-key map (kbd "k") 'image-kill-buffer) (define-key map (kbd "K") 'doc-view-kill-proc) ;; Slicing the image (define-key map (kbd "c s") 'doc-view-set-slice) From 62a6934af9c110c28fc1f69f4bb1b79ce9d0c43d Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 5 Dec 2020 19:40:08 +0000 Subject: [PATCH 017/148] Fix crash when using XRender and restoring image from X (bug#44930) * src/dispextern.h (struct image): Add original dimension elements. * src/image.c (image_set_transform): Store the original dimensions. (image_get_x_image): If we're using transforms use the original dimensions with XGetImage. --- src/dispextern.h | 4 ++++ src/image.c | 9 +++++++++ 2 files changed, 13 insertions(+) diff --git a/src/dispextern.h b/src/dispextern.h index 6b72e68d315..44556276ff5 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3047,6 +3047,10 @@ struct image # if !defined USE_CAIRO && defined HAVE_XRENDER /* Picture versions of pixmap and mask for compositing. */ Picture picture, mask_picture; + + /* We need to store the original image dimensions in case we have to + call XGetImage. */ + int original_width, original_height; # endif #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_NTGUI diff --git a/src/image.c b/src/image.c index 956fb1325ed..7beb135f65c 100644 --- a/src/image.c +++ b/src/image.c @@ -2103,6 +2103,10 @@ image_set_transform (struct frame *f, struct image *img) # if !defined USE_CAIRO && defined HAVE_XRENDER if (!img->picture) return; + + /* Store the original dimensions as we'll overwrite them later. */ + img->original_width = img->width; + img->original_height = img->height; # endif /* Determine size. */ @@ -2930,6 +2934,11 @@ image_get_x_image (struct frame *f, struct image *img, bool mask_p) if (ximg_in_img) return ximg_in_img; +#ifdef HAVE_XRENDER + else if (img->picture) + return XGetImage (FRAME_X_DISPLAY (f), !mask_p ? img->pixmap : img->mask, + 0, 0, img->original_width, img->original_height, ~0, ZPixmap); +#endif else return XGetImage (FRAME_X_DISPLAY (f), !mask_p ? img->pixmap : img->mask, 0, 0, img->width, img->height, ~0, ZPixmap); From 6aa9fe3e1b4052b2acde86404a90e35893ebfa00 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 31 Oct 2020 15:14:34 +0000 Subject: [PATCH 018/148] Fix crash in ns_mouse_position (bug#44313) * src/nsterm.m (ns_destroy_window): Close the window before freeing the frame resources so we don't end up accessing the frame struct after it's been freed. (cherry picked from commit 18a7267c32a909bb26bd93d24543155aeb10e042) --- src/nsterm.m | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/nsterm.m b/src/nsterm.m index 3dd915e3703..4defeee7c3a 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1657,6 +1657,8 @@ ns_destroy_window (struct frame *f) { NSTRACE ("ns_destroy_window"); + check_window_system (f); + /* If this frame has a parent window, detach it as not doing so can cause a crash in GNUStep. */ if (FRAME_PARENT_FRAME (f) != NULL) @@ -1667,7 +1669,7 @@ ns_destroy_window (struct frame *f) [parent removeChildWindow: child]; } - check_window_system (f); + [[FRAME_NS_VIEW (f) window] close]; ns_free_frame_resources (f); ns_window_num--; } From 7ee0fc0dc1a7cba8a3e965f411aca498a7db3f4f Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 12 Dec 2020 14:38:38 +0000 Subject: [PATCH 019/148] CC Mode: Handle several K&R parameters per declaration This fixes bug #45160. * lisp/progmodes/cc-engine.el (c-in-knr-argdecl): Reformulate the latter part of this function using c-do-declarators. --- lisp/progmodes/cc-engine.el | 60 ++++++++++++++++++++----------------- 1 file changed, 32 insertions(+), 28 deletions(-) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 5e2ce71f536..f14ffb38cde 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10837,11 +10837,11 @@ comment at the start of cc-engine.el for more info." (low-lim (max (or lim (point-min)) (or macro-start (point-min)))) before-lparen after-rparen (here (point)) - (pp-count-out 20) ; Max number of paren/brace constructs before - ; we give up. + (pp-count-out 20) ; Max number of paren/brace constructs before + ; we give up ids ; List of identifiers in the parenthesized list. id-start after-prec-token decl-or-cast decl-res - c-last-identifier-range identifier-ok) + c-last-identifier-range semi-position+1) (narrow-to-region low-lim (or macro-end (point-max))) ;; Search backwards for the defun's argument list. We give up if we @@ -10875,8 +10875,8 @@ comment at the start of cc-engine.el for more info." (setq after-rparen (point))) ((eq (char-before) ?\]) (setq after-rparen nil)) - (t ; either } (hit previous defun) or = or no more - ; parens/brackets. + (t ; either } (hit previous defun) or = or no more + ; parens/brackets. (throw 'knr nil))) (if after-rparen @@ -10933,31 +10933,35 @@ comment at the start of cc-engine.el for more info." (forward-char) ; over the ) (setq after-prec-token after-rparen) (c-forward-syntactic-ws) + ;; Each time around the following checks one + ;; declaration (which may contain several identifiers). (while (and - (or (consp (setq decl-or-cast - (c-forward-decl-or-cast-1 - after-prec-token - nil ; Or 'arglist ??? - nil))) - (progn - (goto-char after-prec-token) - (c-forward-syntactic-ws) - (setq identifier-ok (eq (char-after) ?{)) - nil)) - (eq (char-after) ?\;) - (setq after-prec-token (1+ (point))) + (consp (setq decl-or-cast + (c-forward-decl-or-cast-1 + after-prec-token + nil ; Or 'arglist ??? + nil))) + (memq (char-after) '(?\; ?\,)) (goto-char (car decl-or-cast)) - (setq decl-res (c-forward-declarator)) - (setq identifier-ok - (member (buffer-substring-no-properties - (car decl-res) (cadr decl-res)) - ids)) - (progn - (goto-char after-prec-token) - (prog1 (< (point) here) - (c-forward-syntactic-ws)))) - (setq identifier-ok nil)) - identifier-ok)) + (save-excursion + (setq semi-position+1 + (c-syntactic-re-search-forward + ";" (+ (point) 1000) t))) + (c-do-declarators + semi-position+1 t nil nil + (lambda (id-start id-end _next _not-top + _func _init) + (if (not (member + (buffer-substring-no-properties + id-start id-end) + ids)) + (throw 'knr nil)))) + + (progn (forward-char) + (<= (point) here)) + (progn (c-forward-syntactic-ws) + t))) + t)) ;; ...Yes. We've identified the function's argument list. (throw 'knr (progn (goto-char after-rparen) From adbb4eacc2a984c0fc0b65ec761368fd9067d6c5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 09:56:04 -0500 Subject: [PATCH 020/148] * src/keyboard.c: Fix bug#5803. A long time ago, `read_key_sequence` used to read the keymaps at the start, so if something happened between this start and the moment the user actually hits a key, `read_key_sequence` could end up using the wrong keymaps. To work around this problem, the code used `record_asynch_buffer_change` to try and trigger `read_key_sequence` to re-read the keymaps in some known cases. Several years ago, `read_key_sequence` was changed so as to read the keymaps only once the user hits a key, making this machinery now redundant (and also harmful apparently in bug#5803 because it introduces "spurious" events). So we here remove `record_asynch_buffer_change` and the `BUFFER_SWITCH_EVENT` and `Qbuffer_switch` pseudo-events it generated. * src/termhooks.h (enum event_kind): Delete `BUFFER_SWITCH_EVENT`. * src/keyboard.c: (record_asynch_buffer_change): Delete function. (syms_of_keyboard): Delete `Qbuffer_switch`. (force_auto_save_soon, readable_events) (kbd_buffer_store_buffered_event, kbd_buffer_get_event) (make_lispy_event): * src/xterm.c (handle_one_xevent): * src/w32term.c (w32_read_socket): * src/process.c (wait_reading_process_output) (read_and_dispose_of_process_output, exec_sentinel): Simplify accordingly. --- src/keyboard.c | 59 +------------------------------------------------ src/keyboard.h | 1 - src/process.c | 38 ------------------------------- src/termhooks.h | 1 - src/thread.h | 1 - src/w32term.c | 19 ---------------- src/xterm.c | 4 ---- 7 files changed, 1 insertion(+), 122 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 49261fcc3e8..560d92c99f3 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -741,9 +741,6 @@ void force_auto_save_soon (void) { last_auto_save = - auto_save_interval - 1; - /* FIXME: What's the relationship between forcing auto-save and adding - a buffer-switch event? */ - record_asynch_buffer_change (); } #endif @@ -3431,8 +3428,7 @@ readable_events (int flags) && event->ie.part == scroll_bar_handle && event->ie.modifiers == 0) #endif - && !((flags & READABLE_EVENTS_FILTER_EVENTS) - && event->kind == BUFFER_SWITCH_EVENT)) + ) return 1; event = next_kbd_event (event); } @@ -3583,12 +3579,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, return; } } - /* Don't insert two BUFFER_SWITCH_EVENT's in a row. - Just ignore the second one. */ - else if (event->kind == BUFFER_SWITCH_EVENT - && kbd_fetch_ptr != kbd_store_ptr - && prev_kbd_event (kbd_store_ptr)->kind == BUFFER_SWITCH_EVENT) - return; /* Don't let the very last slot in the buffer become full, since that would make the two pointers equal, @@ -3622,7 +3612,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; - case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break; default: ignore_event = Qnil; break; } @@ -3961,7 +3950,6 @@ kbd_buffer_get_event (KBOARD **kbp, #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: #endif - case BUFFER_SWITCH_EVENT: case SAVE_SESSION_EVENT: case NO_EVENT: case HELP_EVENT: @@ -5341,14 +5329,6 @@ make_lispy_event (struct input_event *event) return list2 (Qmove_frame, list1 (event->frame_or_window)); #endif - case BUFFER_SWITCH_EVENT: - { - /* The value doesn't matter here; only the type is tested. */ - Lisp_Object obj; - XSETBUFFER (obj, current_buffer); - return obj; - } - /* Just discard these, by returning nil. With MULTI_KBOARD, these events are used as placeholders when we need to randomly delete events from the queue. @@ -6805,41 +6785,6 @@ get_input_pending (int flags) return input_pending; } -/* Put a BUFFER_SWITCH_EVENT in the buffer - so that read_key_sequence will notice the new current buffer. */ - -void -record_asynch_buffer_change (void) -{ - /* We don't need a buffer-switch event unless Emacs is waiting for input. - The purpose of the event is to make read_key_sequence look up the - keymaps again. If we aren't in read_key_sequence, we don't need one, - and the event could cause trouble by messing up (input-pending-p). - Note: Fwaiting_for_user_input_p always returns nil when async - subprocesses aren't supported. */ - if (!NILP (Fwaiting_for_user_input_p ())) - { - struct input_event event; - - EVENT_INIT (event); - event.kind = BUFFER_SWITCH_EVENT; - event.frame_or_window = Qnil; - event.arg = Qnil; - - /* Make sure no interrupt happens while storing the event. */ -#ifdef USABLE_SIGIO - if (interrupt_input) - kbd_buffer_store_event (&event); - else -#endif - { - stop_polling (); - kbd_buffer_store_event (&event); - start_polling (); - } - } -} - /* Read any terminal input already buffered up by the system into the kbd_buffer, but do not wait. @@ -11573,8 +11518,6 @@ syms_of_keyboard (void) /* Menu and tool bar item parts. */ DEFSYM (Qmenu_enable, "menu-enable"); - DEFSYM (Qbuffer_switch, "buffer-switch"); - #ifdef HAVE_NTGUI DEFSYM (Qlanguage_change, "language-change"); DEFSYM (Qend_session, "end-session"); diff --git a/src/keyboard.h b/src/keyboard.h index 41da3a6bf44..24e9a007888 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -446,7 +446,6 @@ extern void push_kboard (struct kboard *); extern void push_frame_kboard (struct frame *); extern void pop_kboard (void); extern void temporarily_switch_to_single_kboard (struct frame *); -extern void record_asynch_buffer_change (void); extern void input_poll_signal (int); extern void start_polling (void); extern void stop_polling (void); diff --git a/src/process.c b/src/process.c index bf64ead24e5..48b727d9e3b 100644 --- a/src/process.c +++ b/src/process.c @@ -5333,14 +5333,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timer_delay = timer_check (); - /* If a timer has run, this might have changed buffers - an alike. Make read_key_sequence aware of that. */ - if (timers_run != old_timers_run - && (old_buffer != current_buffer - || !EQ (old_window, selected_window)) - && waiting_for_user_input_p == -1) - record_asynch_buffer_change (); - if (timers_run != old_timers_run && do_display) /* We must retry, since a timer may have requeued itself and that could alter the time_delay. */ @@ -5706,14 +5698,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, leave = true; } - /* If a timer has run, this might have changed buffers - an alike. Make read_key_sequence aware of that. */ - if (timers_run != old_timers_run - && waiting_for_user_input_p == -1 - && (old_buffer != current_buffer - || !EQ (old_window, selected_window))) - record_asynch_buffer_change (); - if (leave) break; } @@ -6213,18 +6197,6 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, /* Restore waiting_for_user_input_p as it was when we were called, in case the filter clobbered it. */ waiting_for_user_input_p = waiting; - -#if 0 /* Call record_asynch_buffer_change unconditionally, - because we might have changed minor modes or other things - that affect key bindings. */ - if (! EQ (Fcurrent_buffer (), obuffer) - || ! EQ (current_buffer->keymap, okeymap)) -#endif - /* But do it only if the caller is actually going to read events. - Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make sit_for return). */ - if (waiting_for_user_input_p == -1) - record_asynch_buffer_change (); } DEFUN ("internal-default-process-filter", Finternal_default_process_filter, @@ -7390,16 +7362,6 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) when we were called, in case the filter clobbered it. */ waiting_for_user_input_p = waiting; -#if 0 - if (! EQ (Fcurrent_buffer (), obuffer) - || ! EQ (current_buffer->keymap, okeymap)) -#endif - /* But do it only if the caller is actually going to read events. - Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make sit_for return). */ - if (waiting_for_user_input_p == -1) - record_asynch_buffer_change (); - unbind_to (count, Qnil); } diff --git a/src/termhooks.h b/src/termhooks.h index 44ab14225fd..e94959ca9a3 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -159,7 +159,6 @@ enum event_kind SELECTION_REQUEST_EVENT, /* Another X client wants a selection from us. See `struct selection_input_event'. */ SELECTION_CLEAR_EVENT, /* Another X client cleared our selection. */ - BUFFER_SWITCH_EVENT, /* A process filter has switched buffers. */ DELETE_WINDOW_EVENT, /* An X client said "delete this window". */ #ifdef HAVE_NTGUI END_SESSION_EVENT, /* The user is logging out or shutting down. */ diff --git a/src/thread.h b/src/thread.h index a09929fa440..9697e49f09f 100644 --- a/src/thread.h +++ b/src/thread.h @@ -140,7 +140,6 @@ struct thread_state for user-input when that process-filter was called. waiting_for_input cannot be used as that is by definition 0 when lisp code is being evalled. - This is also used in record_asynch_buffer_change. For that purpose, this must be 0 when not inside wait_reading_process_output. */ int m_waiting_for_user_input_p; diff --git a/src/w32term.c b/src/w32term.c index dc5cd1f6997..a038e4593f4 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -4858,10 +4858,6 @@ w32_read_socket (struct terminal *terminal, inev.kind = DEICONIFY_EVENT; XSETFRAME (inev.frame_or_window, f); } - else if (!NILP (Vframe_list) && !NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later to update the - frame titles in case this is the second frame. */ - record_asynch_buffer_change (); } else { @@ -5479,12 +5475,6 @@ w32_read_socket (struct terminal *terminal, inev.kind = DEICONIFY_EVENT; XSETFRAME (inev.frame_or_window, f); } - else if (! NILP (Vframe_list) - && ! NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later - to update the frame titles - in case this is the second frame. */ - record_asynch_buffer_change (); /* Windows can send us a SIZE_MAXIMIZED message even when fullscreen is fullboth. The following is a @@ -5532,12 +5522,6 @@ w32_read_socket (struct terminal *terminal, inev.kind = DEICONIFY_EVENT; XSETFRAME (inev.frame_or_window, f); } - else if (! NILP (Vframe_list) - && ! NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later - to update the frame titles - in case this is the second frame. */ - record_asynch_buffer_change (); } if (EQ (get_frame_param (f, Qfullscreen), Qmaximized)) @@ -5829,9 +5813,6 @@ w32_read_socket (struct terminal *terminal, SET_FRAME_GARBAGED (f); DebPrint (("obscured frame %p (%s) found to be visible\n", f, SDATA (f->name))); - - /* Force a redisplay sooner or later. */ - record_asynch_buffer_change (); } } } diff --git a/src/xterm.c b/src/xterm.c index 0d2452de929..3de0d2e73c0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8383,10 +8383,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = DEICONIFY_EVENT; XSETFRAME (inev.ie.frame_or_window, f); } - else if (! NILP (Vframe_list) && ! NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later to update the - frame titles in case this is the second frame. */ - record_asynch_buffer_change (); } goto OTHER; From d165b5a46b2a84c637a80200ad6bcf164bbfa77b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 10:16:42 -0500 Subject: [PATCH 021/148] New variable `redisplay_adhoc_scroll_in_resize_mini_windows` * src/xdisp.c (syms_of_xdisp): Define it. (resize_mini_window): Obey it. --- etc/NEWS | 7 +++++++ src/xdisp.c | 58 +++++++++++++++++++++++++++++++++-------------------- 2 files changed, 43 insertions(+), 22 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 901a432d99e..514209516d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -88,6 +88,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. +In addition, there is a new variable +`redisplay-adhoc-scroll-in-resize-mini-windows` to disable the +ad-hoc auto-scrolling when resizing minibuffer windows. It has been +found that its heuristic can be counter productive in some corner +cases, tho the cure may be worse than the disease. This said, the +effect should be negligible in the vast majority of cases anyway. + +++ ** Improved handling of minibuffers on switching frames. By default, when you switch to another frame, an active minibuffer now diff --git a/src/xdisp.c b/src/xdisp.c index 689b87df421..96dd4fade25 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -11751,9 +11751,10 @@ resize_mini_window (struct window *w, bool exact_p) return false; /* By default, start display at the beginning. */ - set_marker_both (w->start, w->contents, - BUF_BEGV (XBUFFER (w->contents)), - BUF_BEGV_BYTE (XBUFFER (w->contents))); + if (redisplay_adhoc_scroll_in_resize_mini_windows) + set_marker_both (w->start, w->contents, + BUF_BEGV (XBUFFER (w->contents)), + BUF_BEGV_BYTE (XBUFFER (w->contents))); /* Nil means don't try to resize. */ if ((NILP (Vresize_mini_windows) @@ -11812,27 +11813,32 @@ resize_mini_window (struct window *w, bool exact_p) if (height > max_height) { height = (max_height / unit) * unit; - init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID); - move_it_vertically_backward (&it, height - unit); - /* The following move is usually a no-op when the stuff - displayed in the mini-window comes entirely from buffer - text, but it is needed when some of it comes from overlay - strings, especially when there's an after-string at ZV. - This happens with some completion packages, like - icomplete, ido-vertical, etc. With those packages, if we - don't force w->start to be at the beginning of a screen - line, important parts of the stuff in the mini-window, - such as user prompt, will be hidden from view. */ - move_it_by_lines (&it, 0); - start = it.current.pos; - /* Prevent redisplay_window from recentering, and thus from - overriding the window-start point we computed here. */ - w->start_at_line_beg = false; + if (redisplay_adhoc_scroll_in_resize_mini_windows) + { + init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID); + move_it_vertically_backward (&it, height - unit); + /* The following move is usually a no-op when the stuff + displayed in the mini-window comes entirely from buffer + text, but it is needed when some of it comes from overlay + strings, especially when there's an after-string at ZV. + This happens with some completion packages, like + icomplete, ido-vertical, etc. With those packages, if we + don't force w->start to be at the beginning of a screen + line, important parts of the stuff in the mini-window, + such as user prompt, will be hidden from view. */ + move_it_by_lines (&it, 0); + start = it.current.pos; + /* Prevent redisplay_window from recentering, and thus from + overriding the window-start point we computed here. */ + w->start_at_line_beg = false; + SET_MARKER_FROM_TEXT_POS (w->start, start); + } } else - SET_TEXT_POS (start, BEGV, BEGV_BYTE); - - SET_MARKER_FROM_TEXT_POS (w->start, start); + { + SET_TEXT_POS (start, BEGV, BEGV_BYTE); + SET_MARKER_FROM_TEXT_POS (w->start, start); + } if (EQ (Vresize_mini_windows, Qgrow_only)) { @@ -35502,6 +35508,14 @@ The initial frame is not displayed anywhere, so skipping it is best except in special circumstances such as running redisplay tests in batch mode. */); redisplay_skip_initial_frame = true; + + DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows", + redisplay_adhoc_scroll_in_resize_mini_windows, + doc: /* If nil always use normal scrolling in minibuffer windows. +Otherwise, use custom-tailored code after resizing minibuffer windows to try +and display the most important part of the minibuffer. */); + /* See bug#43519 for some discussion around this. */ + redisplay_adhoc_scroll_in_resize_mini_windows = true; } From 734f37136558f9cc4ae0d2d3507125d7e65c9986 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 12 Dec 2020 16:24:12 +0100 Subject: [PATCH 022/148] Remove some unused process.c variables * src/process.c (wait_reading_process_output): Remove some variables that are unused after the previous patch. --- src/process.c | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/process.c b/src/process.c index 48b727d9e3b..4fe8ac7fc0c 100644 --- a/src/process.c +++ b/src/process.c @@ -5328,8 +5328,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, do { unsigned old_timers_run = timers_run; - struct buffer *old_buffer = current_buffer; - Lisp_Object old_window = selected_window; timer_delay = timer_check (); @@ -5686,9 +5684,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (read_kbd != 0) { - unsigned old_timers_run = timers_run; - struct buffer *old_buffer = current_buffer; - Lisp_Object old_window = selected_window; bool leave = false; if (detect_input_pending_run_timers (do_display)) From a83d8c9bbe5fbcdeccebfc54d72e1019a951fe52 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 12 Dec 2020 17:32:55 +0200 Subject: [PATCH 023/148] Followup to recent changes in keyboard.c * src/keyboard.c (prev_kbd_event): Now defined only if HAVE_X11. * lisp/subr.el (while-no-input-ignore-events): Remove 'buffer-switch': no longer used or defined. (Bug#5803) --- lisp/subr.el | 2 +- src/keyboard.c | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index c28807f694b..ed235ee1f72 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3964,7 +3964,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; Don't throw `throw-on-input' on those events by default. (setq while-no-input-ignore-events '(focus-in focus-out help-echo iconify-frame - make-frame-visible selection-request buffer-switch)) + make-frame-visible selection-request)) (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. diff --git a/src/keyboard.c b/src/keyboard.c index 560d92c99f3..dbca5be91e4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -384,11 +384,13 @@ next_kbd_event (union buffered_input_event *ptr) return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1; } +#ifdef HAVE_X11 static union buffered_input_event * prev_kbd_event (union buffered_input_event *ptr) { return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1; } +#endif /* Like EVENT_START, but assume EVENT is an event. This pacifies gcc -Wnull-dereference, which might otherwise From a12fe07a8849da0fb68b7233cef839a6a60a6241 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 10:37:42 -0500 Subject: [PATCH 024/148] * lisp/vc/log-edit.el: Keep separator line thin even with line-numbers (log-edit-font-lock-keywords): Disable line-number display on the thin separator line. (log-edit-mode): Adjust `font-lock-extra-managed-props` accordingly. (log-edit-changelog-entries): Don't use a nil buffer-local `change-log-default-name`. --- lisp/vc/log-edit.el | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index feafe5f5f0a..5f978daec02 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -387,7 +387,8 @@ The first subexpression is the actual text of the field.") nil lax)) ("^\n" (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil - (0 '(:height 0.1 :inverse-video t :extend t)))) + (0 '(face (:height 0.1 :inverse-video t :extend t) + display-line-numbers-disable t rear-nonsticky t)))) (log-edit--match-first-line (0 'log-edit-summary)))) (defvar log-edit-font-lock-gnu-style nil @@ -490,6 +491,9 @@ commands (under C-x v for VC, for example). \\{log-edit-mode-map}" (setq-local font-lock-defaults '(log-edit-font-lock-keywords t)) + (make-local-variable 'font-lock-extra-managed-props) + (cl-pushnew 'rear-nonsticky font-lock-extra-managed-props) + (cl-pushnew 'display-line-numbers-disable font-lock-extra-managed-props) (setq-local jit-lock-contextually t) ;For the "first line is summary". (setq-local fill-paragraph-function #'log-edit-fill-entry) (make-local-variable 'log-edit-comment-ring-index) @@ -983,16 +987,17 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each (visiting-buffer (find-buffer-visiting file))) ;; If there is a buffer visiting FILE, and it has a local ;; value for `change-log-default-name', use that. - (if (and visiting-buffer + (or (and visiting-buffer (local-variable-p 'change-log-default-name - visiting-buffer)) - (with-current-buffer visiting-buffer - change-log-default-name) - ;; `find-change-log' uses `change-log-default-name' if set - ;; and sets it before exiting, so we need to work around - ;; that memoizing which is undesired here. - (setq change-log-default-name nil) - (find-change-log))))) + visiting-buffer) + (with-current-buffer visiting-buffer + change-log-default-name)) + ;; `find-change-log' uses `change-log-default-name' if set + ;; and sets it before exiting, so we need to work around + ;; that memoizing which is undesired here. + (progn + (setq change-log-default-name nil) + (find-change-log)))))) (when (or (find-buffer-visiting changelog-file-name) (file-exists-p changelog-file-name) add-log-dont-create-changelog-file) From 8eee54d23adfbd723805851e3904ec21294788ed Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 10:59:50 -0500 Subject: [PATCH 025/148] * src/fns.c (hash_string): Tweak the code further Merge the two main branches; remove the `max` test and thus reduce the "most steps" to 8 as written --- src/fns.c | 52 ++++++++++++++++++++++++---------------------------- 1 file changed, 24 insertions(+), 28 deletions(-) diff --git a/src/fns.c b/src/fns.c index f77092972ab..646c3ed0834 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4525,40 +4525,36 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) EMACS_UINT hash_string (char const *ptr, ptrdiff_t len) { - if (len < 16) - { - char const *p = ptr; - char const *end = p + len; - EMACS_UINT hash = len; + EMACS_UINT const *p = (EMACS_UINT const *) ptr; + EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len); + EMACS_UINT hash = len; + /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, + * but dividing by 8 is cheaper. */ + ptrdiff_t step = 1 + ((end - p) >> 3); - while (p < end) + /* Beware: `end` might be unaligned, so `p < end` is not always the same + * as `p <= end - 1`. */ + while (p <= end - 1) + { + EMACS_UINT c = *p; + p += step; + hash = sxhash_combine (hash, c); + } + if (p < end) + { /* A few last bytes remain (smaller than an EMACS_UINT). */ + /* FIXME: We could do this without a loop, but it'd require + endian-dependent code :-( */ + char const *p1 = (char const *)p; + char const *end1 = (char const *)end; + do { - unsigned char c = *p++; + unsigned char c = *p1++; hash = sxhash_combine (hash, c); } - - return hash; + while (p1 < end1); } - else - { - EMACS_UINT const *p = (EMACS_UINT const *) ptr; - EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len); - EMACS_UINT hash = len; - /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, - * but dividing by 8 is cheaper. */ - ptrdiff_t step = max (1, (end - p) >> 3); - /* Beware: `end` might be unaligned, so `p < end` is not always the same - * as `p <= end - 1`. */ - while (p <= end - 1) - { - EMACS_UINT c = *p; - p += step; - hash = sxhash_combine (hash, c); - } - - return hash; - } + return hash; } /* Return a hash for string PTR which has length LEN. The hash From b1f2eada47adda8349e6f1ef55dfd7a3ed60e6aa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 11:50:00 -0500 Subject: [PATCH 026/148] * lisp/emacs-lisp/package.el (package-buffer-info): Improve error message (package-strip-rcs-id): Return canonicalized version string. --- lisp/emacs-lisp/package.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9c37ce429a7..b7c48dfd3f5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1115,14 +1115,15 @@ boundaries." ;; Use some headers we've invented to drive the process. (let* (;; Prefer Package-Version; if defined, the package author ;; probably wants us to use it. Otherwise try Version. - (pkg-version - (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) + (version-info + (or (lm-header "package-version") (lm-header "version"))) + (pkg-version (package-strip-rcs-id version-info)) (keywords (lm-keywords-list)) (homepage (lm-homepage))) (unless pkg-version - (error - "Package lacks a \"Version\" or \"Package-Version\" header")) + (if version-info + (error "Unrecognized package version: %s" version-info) + (error "Package lacks a \"Version\" or \"Package-Version\" header"))) (package-desc-from-define file-name pkg-version desc (and-let* ((require-lines (lm-header-multiline "package-requires"))) @@ -2112,7 +2113,10 @@ Otherwise return nil." (when str (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) (setq str (substring str (match-end 0)))) - (if (version-to-list str) str))) + (let ((l (version-to-list str))) + ;; Don't return `str' but (package-version-join (version-to-list str)) + ;; to make sure we use a "canonical name"! + (if l (package-version-join l))))) (declare-function lm-homepage "lisp-mnt" (&optional file)) From 8a220d7c8f30fda7239c1dbf7522e0170ef53527 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 3 Dec 2020 15:58:57 -0800 Subject: [PATCH 027/148] New option gnus-registry-register-all * lisp/gnus/gnus-registry.el (gnus-registry-register-all): If nil, the registry won't automatically create new entries for all seen messages. Defaults to t to preserve previous behavior. (gnus-registry-handle-action): Don't automatically create entries; if one doesn't exist, don't handle anything. (gnus-registry-register-message-ids): Only register if this option is t. (gnus-registry-get-or-make-entry): Add optional no-create argument. (gnus-registry-get-id-key): This "get" operation should only create an entry if this option is t. * doc/misc/gnus.texi: Documentation and news. --- doc/misc/gnus.texi | 24 +++++++++++-- etc/NEWS | 7 ++++ lisp/gnus/gnus-registry.el | 72 +++++++++++++++++++++++--------------- 3 files changed, 71 insertions(+), 32 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index cfd3ceda3ff..3743b497da8 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26287,6 +26287,16 @@ registry will keep. If the registry has reached or exceeded this size, it will reject insertion of new entries. @end defvar +@defvar gnus-registry-register-all +If this option is non-nil, the registry will register all messages, as +you see them. This is important to making split-to-parent and +Message-ID references work correctly, as the registry needs to know +where all messages are, but it can slow down group opening and the +saving of Gnus. If this option is nil, entries must be created +manually, for instance by storing a custom flag or keyword for the +message. +@end defvar + @defvar gnus-registry-prune-factor This option (a float between 0 and 1) controls how much the registry is cut back during pruning. In order to prevent constant pruning, the @@ -26376,8 +26386,14 @@ have to put a rule like this: "mail") @end lisp -in your fancy split setup. In addition, you may want to customize the -following variables. +in your fancy split setup. + +If @code{gnus-registry-register-all} is non-nil (the default), the +registry will perform splitting for all messages. If it is nil, +splitting will only happen for children of messages you've explicitly +registered. + +In addition, you may want to customize the following variables. @defvar gnus-registry-track-extra This is a list of symbols, so it's best to change it from the @@ -26450,7 +26466,9 @@ Store @code{value} under @code{key} for message @code{id}. @end defun @defun gnus-registry-get-id-key (id key) -Get the data under @code{key} for message @code{id}. +Get the data under @code{key} for message @code{id}. If the option +@code{gnus-registry-register-all} is non-nil, this function will also +create an entry for @code{id} if one doesn't exist. @end defun @defvar gnus-registry-extra-entries-precious diff --git a/etc/NEWS b/etc/NEWS index 514209516d7..909473f4e77 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -517,6 +517,13 @@ tags to be considered as well. ** Gnus ++++ +*** New user option 'gnus-registry-register-all'. + +If non-nil (the default), create registry entries for all messages. +If nil, don't automatically create entries, they must be created +manually. + +++ *** New user options to customise the summary line specs %[ and %]. Four new options introduced in customisation group diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 65bcd0e8a36..31aee0364cf 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -54,6 +54,9 @@ ;; (: gnus-registry-split-fancy-with-parent) +;; This won't work as expected unless `gnus-registry-register-all' +;; is set to t. + ;; You should also consider using the nnregistry backend to look up ;; articles. See the Gnus manual for more information. @@ -160,6 +163,11 @@ nnmairix groups are specifically excluded because they are ephemeral." (const :tag "Always Install" t) (const :tag "Ask Me" ask))) +(defcustom gnus-registry-register-all nil + "If non-nil, register all articles in the registry." + :type 'boolean + :version "28.1") + (defvar gnus-registry-enabled nil) (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. @@ -478,8 +486,8 @@ This is not required after changing `gnus-registry-cache-file'." (let ((db gnus-registry-db) ;; if the group is ignored, set the destination to nil (same as delete) (to (if (gnus-registry-ignore-group-p to) nil to)) - ;; safe if not found - (entry (gnus-registry-get-or-make-entry id)) + ;; Only retrieve an existing entry, don't create a new one. + (entry (gnus-registry-get-or-make-entry id t)) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject subject))) (sender (gnus-string-remove-all-properties sender))) @@ -488,29 +496,30 @@ This is not required after changing `gnus-registry-cache-file'." ;; several times but it's better to bunch the transactions ;; together - (registry-delete db (list id) nil) - (when from - (setq entry (cons (delete from (assoc 'group entry)) - (assq-delete-all 'group entry)))) - ;; Only keep the entry if the message is going to a new group, or - ;; it's still in some previous group. - (when (or to (alist-get 'group entry)) - (dolist (kv `((group ,to) - (sender ,sender) - (recipient ,@recipients) - (subject ,subject))) - (when (cadr kv) - (let ((new (or (assq (car kv) entry) - (list (car kv))))) - (dolist (toadd (cdr kv)) - (unless (member toadd new) - (setq new (append new (list toadd))))) - (setq entry (cons new - (assq-delete-all (car kv) entry)))))) - (gnus-message 10 "Gnus registry: new entry for %s is %S" - id - entry) - (gnus-registry-insert db id entry)))) + (when entry + (registry-delete db (list id) nil) + (when from + (setq entry (cons (delete from (assoc 'group entry)) + (assq-delete-all 'group entry)))) + ;; Only keep the entry if the message is going to a new group, or + ;; it's still in some previous group. + (when (or to (alist-get 'group entry)) + (dolist (kv `((group ,to) + (sender ,sender) + (recipient ,@recipients) + (subject ,subject))) + (when (cadr kv) + (let ((new (or (assq (car kv) entry) + (list (car kv))))) + (dolist (toadd (cdr kv)) + (unless (member toadd new) + (setq new (append new (list toadd))))) + (setq entry (cons new + (assq-delete-all (car kv) entry)))))) + (gnus-message 10 "Gnus registry: new entry for %s is %S" + id + entry) + (gnus-registry-insert db id entry))))) ;; Function for nn{mail|imap}-split-fancy: look up all references in ;; the cache and if a match is found, return that group. @@ -846,7 +855,8 @@ Overrides existing keywords with FORCE set non-nil." (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group." - (unless (gnus-parameter-registry-ignore gnus-newsgroup-name) + (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name) + (null gnus-registry-register-all)) (dolist (article gnus-newsgroup-articles) (let* ((id (gnus-registry-fetch-message-id-fast article)) (groups (gnus-registry-get-id-key id 'group))) @@ -1082,12 +1092,15 @@ only the last one's marks are returned." "Get the number of groups of a message, based on the message ID." (length (gnus-registry-get-id-key id 'group))) -(defun gnus-registry-get-or-make-entry (id) +(defun gnus-registry-get-or-make-entry (id &optional no-create) + "Return registry entry for ID. +If entry is not found, create a new one, unless NO-create is +non-nil." (let* ((db gnus-registry-db) ;; safe if not found (entries (registry-lookup db (list id)))) - (when (null entries) + (unless (or entries no-create) (gnus-registry-insert db id (list (list 'creation-time (current-time)) '(group) '(sender) '(subject))) (setq entries (registry-lookup db (list id)))) @@ -1098,7 +1111,8 @@ only the last one's marks are returned." (registry-delete gnus-registry-db idlist nil)) (defun gnus-registry-get-id-key (id key) - (cdr-safe (assq key (gnus-registry-get-or-make-entry id)))) + (cdr-safe (assq key (gnus-registry-get-or-make-entry + id (null gnus-registry-register-all))))) (defun gnus-registry-set-id-key (id key vals) (let* ((db gnus-registry-db) From 180e309d8b15b66b588438d157ed1290ab2de7df Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 12 Dec 2020 21:19:26 +0100 Subject: [PATCH 028/148] Bind `C-c C-d' to rmail-epa-decrypt in rmail * doc/emacs/rmail.texi (Rmail Display): Mention the key binding (bug#25411). * lisp/mail/rmail.el (rmail-mode-map): Bind C-c C-d to rmail-epa-decrypt. (rmail-mode): Mention it. (rmail-epa-decrypt): Don't mark a mail as decrypted unless we're replacing it. * lisp/mail/rmailsum.el (rmail-summary-mode-map): Bind C-c C-d. (rmail-summary-epa-decrypt): New command. --- doc/emacs/rmail.texi | 6 +++--- lisp/mail/rmail.el | 7 ++++--- lisp/mail/rmailsum.el | 7 +++++++ 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 14ee062b6cf..467c5269866 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1273,9 +1273,9 @@ temporary buffer to display the current @acronym{MIME} message. @findex rmail-epa-decrypt @cindex encrypted mails (reading in Rmail) - If the current message is an encrypted one, use the command @kbd{M-x -rmail-epa-decrypt} to decrypt it, using the EasyPG library -(@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}). + If the current message is an encrypted one, use the command +@kbd{C-c C-d} (@code{rmail-epa-decrypt}) to decrypt it, using the +EasyPG library (@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}). You can highlight and activate URLs in the Rmail buffer using Goto Address mode: diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 63d992d2717..3c74edd1054 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1080,6 +1080,7 @@ The buffer is expected to be narrowed to just the header of the message." (define-key map [?\S-\ ] 'scroll-down-command) (define-key map "\177" 'scroll-down-command) (define-key map "?" 'describe-mode) + (define-key map "\C-c\C-d" 'rmail-epa-decrypt) (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author) @@ -1272,6 +1273,7 @@ Instead, these commands are available: \\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages till a deleted message is found. \\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. +\\[rmail-epa-decrypt] Decrypt the current message. \\[rmail-expunge] Expunge deleted messages. \\[rmail-expunge-and-save] Expunge and save the file. \\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. @@ -4610,11 +4612,10 @@ Argument MIME is non-nil if this is a mime message." "> ") (push (rmail-epa-decrypt-1 mime) decrypts)))) - (when (and decrypts (eq major-mode 'rmail-mode)) - (rmail-add-label "decrypt")) - (when (and decrypts (rmail-buffers-swapped-p)) (when (y-or-n-p "Replace the original message? ") + (when (eq major-mode 'rmail-mode) + (rmail-add-label "decrypt")) (setq decrypts (nreverse decrypts)) (let ((beg (rmail-msgbeg rmail-current-message)) (end (rmail-msgend rmail-current-message))) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index a085e0bc4ff..9ccc0cfee97 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -121,6 +121,7 @@ Setting this option to nil might speed up the generation of summaries." (define-key map [?\S-\ ] 'rmail-summary-scroll-msg-down) (define-key map "\177" 'rmail-summary-scroll-msg-down) (define-key map "?" 'describe-mode) + (define-key map "\C-c\C-d" 'rmail-summary-epa-decrypt) (define-key map "\C-c\C-n" 'rmail-summary-next-same-subject) (define-key map "\C-c\C-p" 'rmail-summary-previous-same-subject) (define-key map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date) @@ -1482,6 +1483,12 @@ argument says to read a file name and use that file as the inbox." (rmail-edit-current-message) (use-local-map rmail-summary-edit-map)) +(defun rmail-summary-epa-decrypt () + "Decrypt this message." + (interactive) + (rmail-pop-to-buffer rmail-buffer) + (rmail-epa-decrypt)) + (defun rmail-summary-cease-edit () "Finish editing message, then go back to Rmail summary buffer." (interactive) From 4bf98aecffe57648d15db90718134b00ac87ec3b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 12 Dec 2020 21:59:08 +0100 Subject: [PATCH 029/148] Fix BSD .include etc syntax in Makefiles * lisp/progmodes/make-mode.el (makefile-bsdmake-statements): Fix the BSD conditional syntax (bug#24000). (makefile-make-font-lock-keywords): Allow calling without keywords. (makefile-bsdmake-font-lock-keywords): Add the conditional syntax. Makefile inclusion, conditional structures and for loops reminiscent of the C programming language are provided in make. All such structures are identified by a line beginning with a single dot (`.') character. Whitespace characters may follow this dot, e.g., .include and . include are identical constructs --- lisp/progmodes/make-mode.el | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 3e49f84dbce..8b6a7fc1b48 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -343,8 +343,9 @@ not be enclosed in { } or ( )." "List of keywords understood by gmake.") (defconst makefile-bsdmake-statements - '(".elif" ".elifdef" ".elifmake" ".elifndef" ".elifnmake" ".else" ".endfor" - ".endif" ".for" ".if" ".ifdef" ".ifmake" ".ifndef" ".ifnmake" ".undef") + '("elif" "elifdef" "elifmake" "elifndef" "elifnmake" "else" "endfor" + "endif" "for" "if" "ifdef" "ifmake" "ifndef" "ifnmake" "poison" + "undef" "include") "List of keywords understood by BSD make.") (defun makefile-make-font-lock-keywords (var keywords space @@ -376,8 +377,9 @@ not be enclosed in { } or ( )." ("[^$]\\(\\$[@%*]\\)" 1 'makefile-targets append) - ;; Fontify conditionals and includes. - (,(concat "^\\(?: [ \t]*\\)?" + ,@(if keywords + ;; Fontify conditionals and includes. + `((,(concat "^\\(?: [ \t]*\\)?" (replace-regexp-in-string " " "[ \t]+" (if (eq (car keywords) t) @@ -385,7 +387,7 @@ not be enclosed in { } or ( )." (regexp-opt (cdr keywords) t)) (regexp-opt keywords t))) "\\>[ \t]*\\([^: \t\n#]*\\)") - (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) + (1 font-lock-keyword-face) (2 font-lock-variable-name-face)))) ,@(if negation `((,negation (1 font-lock-negation-char-face prepend) @@ -493,13 +495,17 @@ not be enclosed in { } or ( )." 1 'makefile-makepp-perl t))) (defconst makefile-bsdmake-font-lock-keywords - (makefile-make-font-lock-keywords - ;; A lot more could be done for variables here: - makefile-var-use-regex - makefile-bsdmake-statements - t - "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)" - '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face))) + (append + (makefile-make-font-lock-keywords + ;; A lot more could be done for variables here: + makefile-var-use-regex + nil + t + "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)" + '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face)) + `((,(concat "^\\. *" (regexp-opt makefile-bsdmake-statements) "\\>") 0 + font-lock-keyword-face)))) + (defconst makefile-imake-font-lock-keywords (append From 52e3ac6303292fdea8f441821a40f8f5ca31e3de Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 12 Dec 2020 23:21:18 +0100 Subject: [PATCH 030/148] Document and enforce some properties for strings created by modules. When creating multibyte or unibyte strings, we should guarantee the following invariants: - When creating empty strings, a NULL data pointer should be allowed. This often arises in practice if the string length isn't known in advance, and we don't want to unnecessarily trigger undefined behavior. Since functions like memcpy might not accept NULL pointers, use the canonical empty string objects in this case. - Nonzero strings should be guaranteed to be unique and mutable. These are the same guarantees expected from Lisp functions such as 'make-string' or 'unibyte-string'. On the other hand, empty strings might not be unique. * src/emacs-module.c (module_make_string) (module_make_unibyte_string): Correctly handle empty strings. * test/src/emacs-module-resources/mod-test.c (Fmod_test_make_string): New test function. (emacs_module_init): Expose it. * test/src/emacs-module-tests.el (mod-test-make-string/empty) (mod-test-make-string/nonempty): New unit tests. * doc/lispref/internals.texi (Module Values): Document properties and corner cases for strings. --- doc/lispref/internals.texi | 5 +++- src/emacs-module.c | 8 +++--- test/src/emacs-module-resources/mod-test.c | 30 ++++++++++++++++++++++ test/src/emacs-module-tests.el | 20 +++++++++++++++ 4 files changed, 58 insertions(+), 5 deletions(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index fb24544c917..28a5fdb3492 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1864,7 +1864,10 @@ byte, is @var{len}. The original string in @var{str} can be either an it can include embedded null bytes, and doesn't have to end in a terminating null byte at @code{@var{str}[@var{len}]}. The function raises the @code{overflow-error} error condition if @var{len} is -negative or exceeds the maximum length of an Emacs string. +negative or exceeds the maximum length of an Emacs string. If +@var{len} is zero, then @var{str} can be @code{NULL}, otherwise it +must point to valid memory. For nonzero @var{len}, @code{make_string} +returns unique mutable string objects. @end deftypefn @deftypefn Function emacs_value make_unibyte_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len}) diff --git a/src/emacs-module.c b/src/emacs-module.c index 0f3ef59fd8c..b7cd835c83c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -784,7 +784,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len) MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= len && len <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = module_decode_utf_8 (str, len); + Lisp_Object lstr + = len == 0 ? empty_multibyte_string : module_decode_utf_8 (str, len); return lisp_to_value (env, lstr); } @@ -794,9 +795,8 @@ module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length) MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = make_uninit_string (length); - memcpy (SDATA (lstr), str, length); - SDATA (lstr)[length] = 0; + Lisp_Object lstr + = length == 0 ? empty_unibyte_string : make_unibyte_string (str, length); return lisp_to_value (env, lstr); } diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index f855e9b6da0..30ad352cf8b 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include #include @@ -699,6 +700,34 @@ Fmod_test_funcall (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return env->funcall (env, args[0], nargs - 1, args + 1); } +static emacs_value +Fmod_test_make_string (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + assert (nargs == 2); + intmax_t length_arg = env->extract_integer (env, args[0]); + if (env->non_local_exit_check (env) != emacs_funcall_exit_return) + return args[0]; + if (length_arg < 0 || SIZE_MAX < length_arg) + { + signal_error (env, "Invalid string length"); + return args[0]; + } + size_t length = (size_t) length_arg; + bool multibyte = env->is_not_nil (env, args[1]); + char *buffer = length == 0 ? NULL : malloc (length); + if (buffer == NULL && length != 0) + { + memory_full (env); + return args[0]; + } + memset (buffer, 'a', length); + emacs_value ret = multibyte ? env->make_string (env, buffer, length) + : env->make_unibyte_string (env, buffer, length); + free (buffer); + return ret; +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -790,6 +819,7 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL); DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function, NULL, NULL); + DEFUN ("mod-test-make-string", Fmod_test_make_string, 2, 2, NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 99d4cafb4af..bf26ffb935c 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -30,6 +30,7 @@ (require 'ert) (require 'ert-x) (require 'help-fns) +(require 'subr-x) (defconst mod-test-emacs (expand-file-name invocation-name invocation-directory) @@ -556,4 +557,23 @@ See Bug#36226." (thread-join thread-1) (thread-join thread-2))) +(ert-deftest mod-test-make-string/empty () + (dolist (multibyte '(nil t)) + (ert-info ((format "Multibyte: %s" multibyte)) + (let ((got (mod-test-make-string 0 multibyte))) + (should (stringp got)) + (should (string-empty-p got)) + (should (eq (multibyte-string-p got) multibyte)))))) + +(ert-deftest mod-test-make-string/nonempty () + (dolist (multibyte '(nil t)) + (ert-info ((format "Multibyte: %s" multibyte)) + (let ((first (mod-test-make-string 1 multibyte)) + (second (mod-test-make-string 1 multibyte))) + (should (stringp first)) + (should (eql (length first) 1)) + (should (eq (multibyte-string-p first) multibyte)) + (should (string-equal first second)) + (should-not (eq first second)))))) + ;;; emacs-module-tests.el ends here From 89c6efc6903bd967930a192dfdaeed3551c08b51 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 12 Dec 2020 23:51:30 +0100 Subject: [PATCH 031/148] Remove references to Emacs before version 22 from FAQ * doc/misc/efaq.texi (Escape sequences in shell output): Remove reference to versions before Emacs 21. (Basic editing, Latest version of Emacs) (Turning on abbrevs by default, Going to a line by number) (Security risks with Emacs): Remove references to versions before Emacs 22. --- doc/misc/efaq.texi | 61 +++++++++++++++++++--------------------------- 1 file changed, 25 insertions(+), 36 deletions(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 1bc9d41f9bb..462eb4cf3ae 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -512,10 +512,10 @@ This chapter tells you how to get help with Emacs. @cindex Help system, entering the Type @kbd{C-h t} to invoke the self-paced tutorial. Just typing -@kbd{C-h} enters the help system. Starting with Emacs 22, the tutorial -is available in many foreign languages such as French, German, Japanese, -Russian, etc. Use @kbd{M-x help-with-tutorial-spec-language @key{RET}} -to choose your language and start the tutorial. +@kbd{C-h} enters the help system. The tutorial is available in many +foreign languages such as French, German, Japanese, Russian, etc. Use +@kbd{M-x help-with-tutorial-spec-language @key{RET}} to choose your +language and start the tutorial. Your system administrator may have changed @kbd{C-h} to act like @key{DEL} to deal with local keyboards. You can use @kbd{M-x @@ -966,9 +966,9 @@ latest features, you may want to stick to the releases. The following sections list some of the major new features in the last few Emacs releases. For full details of the changes in any version of -Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). As of Emacs 22, -you can give this command a prefix argument to read about which features -were new in older versions. +Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). You can give +this command a prefix argument to read about which features were new +in older versions. @node New in Emacs 26 @section What is different about Emacs 26? @@ -1725,14 +1725,6 @@ buffer by default, put this in your @file{.emacs} file: (setq abbrev-mode t))) @end lisp -@noindent If your Emacs version is older then 22.1, you will also need to use: - -@lisp -(condition-case () - (quietly-read-abbrev-file) - (file-error nil)) -@end lisp - @node Associating modes with files @section How do I make Emacs use a certain major mode for certain files? @cindex Associating modes with files @@ -2583,16 +2575,14 @@ effective way of doing that. Emacs automatically intercepts the compile error messages, inserts them into a special buffer called @file{*compilation*}, and lets you visit the locus of each message in the source. Type @kbd{C-x `} to step through the offending lines one by -one (starting with Emacs 22, you can also use @kbd{M-g M-p} and -@kbd{M-g M-n} to go to the previous and next matches directly). Click -@kbd{mouse-2} or press @key{RET} on a message text in the -@file{*compilation*} buffer to go to the line whose number is mentioned -in that message. +one (you can also use @kbd{M-g M-p} and @kbd{M-g M-n} to go to the +previous and next matches directly). Click @kbd{mouse-2} or press +@key{RET} on a message text in the @file{*compilation*} buffer to go +to the line whose number is mentioned in that message. But if you indeed need to go to a certain text line, type @kbd{M-g M-g} -(which is the default binding of the @code{goto-line} function starting -with Emacs 22). Emacs will prompt you for the number of the line and go -to that line. +(which is the default binding of the @code{goto-line} function). +Emacs will prompt you for the number of the line and go to that line. You can do this faster by invoking @code{goto-line} with a numeric argument that is the line's number. For example, @kbd{C-u 286 M-g M-g} @@ -2825,13 +2815,13 @@ Add the following line to your @file{.emacs} file: @cindex @code{ls} in Shell mode In many systems, @code{ls} is aliased to @samp{ls --color}, which -prints using ANSI color escape sequences. Emacs version 21.1 and -later includes the @code{ansi-color} package, which lets Shell mode -recognize these escape sequences. In Emacs 23.2 and later, the -package is enabled by default; in earlier versions you can enable it -by typing @kbd{M-x ansi-color-for-comint-mode} in the Shell buffer, or -by adding @code{(add-hook 'shell-mode-hook -'ansi-color-for-comint-mode-on)} to your init file. +prints using ANSI color escape sequences. Emacs includes the +@code{ansi-color} package, which lets Shell mode recognize these +escape sequences. In Emacs 23.2 and later, the package is enabled by +default; in earlier versions you can enable it by typing @kbd{M-x +ansi-color-for-comint-mode} in the Shell buffer, or by adding +@code{(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)} to +your init file. @node Fullscreen mode on MS-Windows @section How can I start Emacs in fullscreen mode on MS-Windows? @@ -3210,12 +3200,11 @@ arbitrary Emacs Lisp code evaluated when the file is visited. Obviously, there is a potential for Trojan horses to exploit this feature. -As of Emacs 22, Emacs has a list of local variables that are known to -be safe to set. If a file tries to set any variable outside this -list, it asks the user to confirm whether the variables should be set. -You can also tell Emacs whether to allow the evaluation of Emacs Lisp -code found at the bottom of files by setting the variable -@code{enable-local-eval}. +Emacs has a list of local variables that are known to be safe to set. +If a file tries to set any variable outside this list, it asks the +user to confirm whether the variables should be set. You can also tell +Emacs whether to allow the evaluation of Emacs Lisp code found at the +bottom of files by setting the variable @code{enable-local-eval}. @xref{File Variables,,, emacs, The GNU Emacs Manual}. From c6f21e2420202a19a590c66ecc09bf8bb277778d Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 12 Dec 2020 23:52:00 +0000 Subject: [PATCH 032/148] Fix assertion on SVG load failure * src/image.c (svg_load_image): Move setting DPI to after rsvg_handle error checking. --- src/image.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/image.c b/src/image.c index 6b85ab78f61..a3301ad2dda 100644 --- a/src/image.c +++ b/src/image.c @@ -9872,8 +9872,6 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file, RSVG_HANDLE_FLAGS_NONE, NULL, &err); - rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, - FRAME_DISPLAY_INFO (f)->resy); if (base_file) g_object_unref (base_file); @@ -9881,6 +9879,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, /* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */ if (!rsvg_handle || err) goto rsvg_error; + + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); #else /* Make a handle to a new rsvg object. */ rsvg_handle = rsvg_handle_new (); @@ -10045,15 +10046,15 @@ svg_load_image (struct frame *f, struct image *img, char *contents, RSVG_HANDLE_FLAGS_NONE, NULL, &err); - rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, - FRAME_DISPLAY_INFO (f)->resy); - if (base_file) g_object_unref (base_file); g_object_unref (input_stream); /* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */ if (!rsvg_handle || err) goto rsvg_error; + + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); #else /* Make a handle to a new rsvg object. */ rsvg_handle = rsvg_handle_new (); From 185b0820b83b2021b4223c443effdd35be0adc2a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 19:19:03 -0500 Subject: [PATCH 033/148] * lisp/emacs-lisp/bytecomp.el: Allow a nil destination file (byte-compile--default-dest-file): New function, extracted from byte-compile-dest-file. (byte-compile-dest-file): Use it. (byte-compile-dest-file-function): Give it a non-nil default value. (byte-recompile-file, byte-compile-file): Handle a nil return value from `byte-compile-dest-file`. * lisp/progmodes/elisp-mode.el (elisp-flymake--batch-compile-for-flymake): Tell the compiler not to write the result, instead of writing it to a dummy temp file. --- lisp/emacs-lisp/bytecomp.el | 119 ++++++++++++++++++----------------- lisp/progmodes/elisp-mode.el | 6 +- 2 files changed, 62 insertions(+), 63 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0acd5276977..51accc08654 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)" ;; Eg is_elc in Fload. :type 'regexp) -(defcustom byte-compile-dest-file-function nil +(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file "Function for the function `byte-compile-dest-file' to call. It should take one argument, the name of an Emacs Lisp source file name, and return the name of the compiled file. @@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension \".el\"), replaces the matching part (and anything after it) with \".elc\"; otherwise adds \".elc\"." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc"))))) -) + (funcall (or byte-compile-dest-file-function + #'byte-compile--default-dest-file) + filename))) + +(defun byte-compile--default-dest-file (filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc")))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") @@ -1809,24 +1811,23 @@ If compilation is needed, this functions returns the result of (let ((dest (byte-compile-dest-file filename)) ;; Expand now so we get the current buffer's defaults (filename (expand-file-name filename))) - (if (if (file-exists-p dest) - ;; File was already compiled - ;; Compile if forced to, or filename newer - (or force - (file-newer-than-file-p filename dest)) - (and arg - (or (eq 0 arg) - (y-or-n-p (concat "Compile " - filename "? "))))) - (progn - (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." filename)) - (byte-compile-file filename) - (when load - (load (if (file-exists-p dest) dest filename)))) + (prog1 + (if (if (and dest (file-exists-p dest)) + ;; File was already compiled + ;; Compile if forced to, or filename newer + (or force + (file-newer-than-file-p filename dest)) + (and arg + (or (eq 0 arg) + (y-or-n-p (concat "Compile " + filename "? "))))) + (progn + (if (and noninteractive (not byte-compile-verbose)) + (message "Compiling %s..." filename)) + (byte-compile-file filename)) + 'no-byte-compile) (when load - (load (if (file-exists-p dest) dest filename))) - 'no-byte-compile))) + (load (if (and dest (file-exists-p dest)) dest filename)))))) (defun byte-compile--load-dynvars (file) (and file (not (equal file "")) @@ -1936,7 +1937,7 @@ See also `emacs-lisp-byte-compile-and-load'." ;; (message "%s not compiled because of `no-byte-compile: %s'" ;; (byte-compile-abbreviate-file filename) ;; (with-current-buffer input-buffer no-byte-compile)) - (when (file-exists-p target-file) + (when (and target-file (file-exists-p target-file)) (message "%s deleted because of `no-byte-compile: %s'" (byte-compile-abbreviate-file target-file) (buffer-local-value 'no-byte-compile input-buffer)) @@ -1960,36 +1961,38 @@ See also `emacs-lisp-byte-compile-and-load'." (with-current-buffer output-buffer (goto-char (point-max)) (insert "\n") ; aaah, unix. - (if (file-writable-p target-file) - ;; We must disable any code conversion here. - (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 (expand-file-name 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 'nofollow)) - (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))) + (cond + ((null target-file) nil) ;We only wanted the warnings! + ((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-file (expand-file-name 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 'nofollow)) + (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))) + (t ;; This is just to give a better error message than write-region (let ((exists (file-exists-p target-file))) (signal (if exists 'file-error 'file-missing) @@ -1997,7 +2000,7 @@ See also `emacs-lisp-byte-compile-and-load'." (if exists "Cannot overwrite file" "Directory not writable or nonexistent") - target-file)))) + target-file))))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index fa360a8f3f8..b7e0c452288 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1827,12 +1827,9 @@ Runs in a batch-mode Emacs. Interactively use variable (interactive (list buffer-file-name)) (let* ((file (or file (car command-line-args-left))) - (dummy-elc-file) (byte-compile-log-buffer (generate-new-buffer " *dummy-byte-compile-log-buffer*")) - (byte-compile-dest-file-function - (lambda (source) - (setq dummy-elc-file (make-temp-file (file-name-nondirectory source))))) + (byte-compile-dest-file-function #'ignore) (collected) (byte-compile-log-warning-function (lambda (string &optional position fill level) @@ -1842,7 +1839,6 @@ Runs in a batch-mode Emacs. Interactively use variable (unwind-protect (byte-compile-file file) (ignore-errors - (delete-file dummy-elc-file) (kill-buffer byte-compile-log-buffer))) (prin1 :elisp-flymake-output-start) (terpri) From ebab7c48c3b78503b5341974c256388a26e5b880 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 13 Dec 2020 03:58:32 +0200 Subject: [PATCH 034/148] Fix test failure * test/lisp/vc/vc-tests.el (vc-test--working-revision): Accept working revision -1, expected for older Hg (bug#36534). --- test/lisp/vc/vc-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 7b88b8d531a..a2936cca824 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -439,8 +439,9 @@ This checks also `vc-backend' and `vc-responsible-backend'." ;; nil: Git Mtn ;; "0": Bzr CVS Hg SRC SVN ;; "1.1": RCS SCCS + ;; "-1": Hg versions before 5 (probably) (message "vc-working-revision4 %s" (vc-working-revision tmp-name)) - (should (member (vc-working-revision tmp-name) '(nil "0" "1.1"))) + (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1"))) ;; TODO: Call `vc-checkin', and check the resulting ;; working revision. None of the return values should be From 6fc1b795c1bfaded853b1dff225b0c3628014dd7 Mon Sep 17 00:00:00 2001 From: Andrii Kolomoiets Date: Fri, 11 Dec 2020 15:55:22 +0200 Subject: [PATCH 035/148] vc-create-tag: use vc-revision-history variable * lisp/vc/vc.el (vc-create-tag): Use 'vc-revision-history' variable. --- lisp/vc/vc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b3b05839662..7d9af00de7c 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2325,7 +2325,8 @@ checked out in that new branch." ;; to ask for a directory, branches are created at repository level. default-directory (read-directory-name "Directory: " default-directory default-directory t)) - (read-string (if current-prefix-arg "New branch name: " "New tag name: ")) + (read-string (if current-prefix-arg "New branch name: " "New tag name: ") + nil 'vc-revision-history) current-prefix-arg))) (message "Making %s... " (if branchp "branch" "tag")) (when (file-directory-p dir) (setq dir (file-name-as-directory dir))) From 2d790c6c57b244447390c023679752243e0049c9 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 13 Dec 2020 04:12:35 +0200 Subject: [PATCH 036/148] Bump project.el version * lisp/progmodes/project.el: Bump the version. --- lisp/progmodes/project.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 98ad41487a1..0ed5f1f907c 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. -;; Version: 0.5.2 +;; Version: 0.5.3 ;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) ;; This is a GNU ELPA :core package. Avoid using functionality that From 831659b3b88d42ea5e4adab2be3316cfffa2efd1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 13 Dec 2020 01:11:56 +0100 Subject: [PATCH 037/148] * Fix `memory-report' for '--without-x' builds * lisp/emacs-lisp/memory-report.el (memory-report--image-cache): Don't call `image-cache-size' if unbound. --- lisp/emacs-lisp/memory-report.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index c88d9f2768a..04ae87d9ea0 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -294,7 +294,9 @@ by counted more than once." (overlay-lists))))) (defun memory-report--image-cache () - (list (cons "Total Image Cache Size" (image-cache-size)))) + (list (cons "Total Image Cache Size" (if (fboundp 'image-cache-size) + (image-cache-size) + 0)))) (provide 'memory-report) From f22856a5c54d99867cd24c08a14bbda23d5c6229 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sun, 13 Dec 2020 13:44:15 +0100 Subject: [PATCH 038/148] Update to Org 9.4.1 --- doc/misc/org.texi | 1216 ++++++---- etc/ORG-NEWS | 593 ++++- etc/refcards/orgcard.tex | 11 +- lisp/org/ob-C.el | 10 +- lisp/org/ob-J.el | 9 +- lisp/org/ob-R.el | 9 +- lisp/org/ob-abc.el | 4 +- lisp/org/ob-asymptote.el | 2 - lisp/org/ob-awk.el | 2 - lisp/org/ob-calc.el | 2 - lisp/org/ob-clojure.el | 336 ++- lisp/org/ob-comint.el | 2 - lisp/org/ob-coq.el | 4 +- lisp/org/ob-core.el | 533 +++-- lisp/org/ob-css.el | 2 - lisp/org/ob-ditaa.el | 2 - lisp/org/ob-dot.el | 2 - lisp/org/ob-ebnf.el | 26 +- lisp/org/ob-emacs-lisp.el | 51 +- lisp/org/ob-eval.el | 2 - lisp/org/ob-exp.el | 8 +- lisp/org/ob-forth.el | 3 +- lisp/org/ob-fortran.el | 5 +- lisp/org/ob-gnuplot.el | 4 +- lisp/org/ob-groovy.el | 4 - lisp/org/ob-haskell.el | 86 +- lisp/org/ob-hledger.el | 5 +- lisp/org/ob-io.el | 3 - lisp/org/ob-java.el | 7 +- lisp/org/ob-js.el | 10 +- lisp/org/ob-latex.el | 12 +- lisp/org/ob-ledger.el | 2 - lisp/org/ob-lilypond.el | 13 +- lisp/org/ob-lisp.el | 2 - lisp/org/ob-lua.el | 5 +- lisp/org/ob-makefile.el | 2 - lisp/org/ob-matlab.el | 2 - lisp/org/ob-maxima.el | 5 - lisp/org/ob-mscgen.el | 5 +- lisp/org/ob-ocaml.el | 2 - lisp/org/ob-octave.el | 8 +- lisp/org/ob-org.el | 2 - lisp/org/ob-perl.el | 2 - lisp/org/ob-picolisp.el | 8 +- lisp/org/ob-plantuml.el | 107 +- lisp/org/ob-python.el | 219 +- lisp/org/ob-ref.el | 4 +- lisp/org/ob-ruby.el | 32 +- lisp/org/ob-sass.el | 4 +- lisp/org/ob-scheme.el | 11 +- lisp/org/ob-screen.el | 17 +- lisp/org/ob-sed.el | 5 +- lisp/org/ob-shell.el | 59 +- lisp/org/ob-shen.el | 1 + lisp/org/ob-sql.el | 118 +- lisp/org/ob-sqlite.el | 7 +- lisp/org/ob-stan.el | 3 +- lisp/org/ob-table.el | 5 +- lisp/org/ob-tangle.el | 60 +- lisp/org/ob-vala.el | 2 +- lisp/org/ol-bbdb.el | 37 +- lisp/org/ol-bibtex.el | 23 +- lisp/org/ol-docview.el | 3 +- lisp/org/ol-eshell.el | 2 +- lisp/org/ol-eww.el | 15 +- lisp/org/ol-gnus.el | 32 +- lisp/org/ol-info.el | 2 +- lisp/org/ol-irc.el | 2 +- lisp/org/ol-mhe.el | 2 +- lisp/org/ol-rmail.el | 6 +- lisp/org/ol.el | 495 ++-- lisp/org/org-agenda.el | 1252 +++++----- lisp/org/org-archive.el | 54 +- lisp/org/org-attach.el | 154 +- lisp/org/org-capture.el | 142 +- lisp/org/org-clock.el | 141 +- lisp/org/org-colview.el | 53 +- lisp/org/org-compat.el | 135 +- lisp/org/org-crypt.el | 229 +- lisp/org/org-datetree.el | 29 +- lisp/org/org-duration.el | 52 +- lisp/org/org-element.el | 268 +-- lisp/org/org-entities.el | 4 +- lisp/org/org-faces.el | 29 +- lisp/org/org-goto.el | 38 +- lisp/org/org-habit.el | 11 +- lisp/org/org-id.el | 131 +- lisp/org/org-indent.el | 29 +- lisp/org/org-keys.el | 20 +- lisp/org/org-lint.el | 77 +- lisp/org/org-list.el | 646 +++--- lisp/org/org-macro.el | 58 +- lisp/org/org-macs.el | 89 +- lisp/org/org-mobile.el | 11 + lisp/org/org-mouse.el | 10 +- lisp/org/org-num.el | 7 +- lisp/org/org-pcomplete.el | 36 +- lisp/org/org-plot.el | 46 +- lisp/org/org-protocol.el | 30 +- lisp/org/org-refile.el | 742 ++++++ lisp/org/org-src.el | 88 +- lisp/org/org-table.el | 546 +++-- lisp/org/org-tempo.el | 4 +- lisp/org/org-timer.el | 19 +- lisp/org/org-version.el | 4 +- lisp/org/org.el | 4566 ++++++++++++++++++------------------- lisp/org/ox-ascii.el | 17 +- lisp/org/ox-beamer.el | 2 +- lisp/org/ox-html.el | 351 ++- lisp/org/ox-icalendar.el | 11 +- lisp/org/ox-latex.el | 88 +- lisp/org/ox-man.el | 22 +- lisp/org/ox-md.el | 345 +-- lisp/org/ox-odt.el | 38 +- lisp/org/ox-org.el | 4 +- lisp/org/ox-publish.el | 11 +- lisp/org/ox-texinfo.el | 23 +- lisp/org/ox.el | 322 ++- 118 files changed, 9010 insertions(+), 6270 deletions(-) create mode 100644 lisp/org/org-refile.el diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 6f6fcd640d0..29713f18bc2 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -7,13 +7,13 @@ @set txicodequoteundirected @set txicodequotebacktick @set MAINTAINERSITE @uref{https://orgmode.org,maintainers webpage} -@set MAINTAINER Carsten Dominik -@set MAINTAINEREMAIL @email{carsten at orgmode dot org} -@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer} +@set MAINTAINER Bastien Guerry +@set MAINTAINEREMAIL @email{bzg@gnu.org} +@set MAINTAINERCONTACT @uref{mailto:bzg@gnu.org,contact the maintainer} @c %**end of header @copying -This manual is for Org version 9.3. +This manual is for Org version 9.4. Copyright @copyright{} 2004--2020 Free Software Foundation, Inc. @@ -39,7 +39,7 @@ modify this GNU manual.'' @finalout @titlepage @title The Org Manual -@subtitle Release 9.3 +@subtitle Release 9.4 @author The Org Mode Developers @page @vskip 0pt plus 1filll @@ -402,6 +402,10 @@ Texinfo Export * Special blocks in Texinfo export:: Special block attributes. * A Texinfo example:: Processing Org to Texinfo. +Export in Foreign Buffers + +* Bare HTML:: Exporting HTML without CSS, Javascript, etc. + Publishing * Configuration:: Defining projects. @@ -427,6 +431,7 @@ Sample Configuration Working with Source Code +* Features Overview:: Enjoy the versatility of source blocks. * Structure of Code Blocks:: Code block syntax described. * Using Header Arguments:: Different ways to set header arguments. * Environment of a Code Block:: Arguments, sessions, working directory... @@ -447,12 +452,13 @@ Miscellaneous * Structure Templates:: Quick insertion of structural elements. * Speed Keys:: Electric commands at the beginning of a headline. * Clean View:: Getting rid of leading stars in the outline. +* Execute commands in the active region:: Execute commands on multiple items in Org or agenda view. * Dynamic Headline Numbering:: Display and update outline numbering. * The Very Busy @kbd{C-c C-c} Key:: When in doubt, press @kbd{C-c C-c}. * In-buffer Settings:: Overview of keywords. * Org Syntax:: Formal description of Org's syntax. * Documentation Access:: Read documentation about current syntax. -* Escape Character:: +* Escape Character:: Prevent Org from interpreting your writing. * Code Evaluation Security:: Org files evaluate in-line code. * Interaction:: With other Emacs packages. * TTY Keys:: Using Org on a tty. @@ -549,7 +555,7 @@ 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 +suited for 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. @@ -603,7 +609,8 @@ We @strong{strongly recommend} sticking to a single installation method. @subheading Using Emacs packaging system Recent Emacs distributions include a packaging system which lets you -install Elisp libraries. You can install Org with @kbd{M-x package-install @key{RET} org}. +install Elisp libraries. You can install Org from the ``package menu'', +with @kbd{M-x list-packages}. See @ref{Package Menu,Package Menu,,emacs,}. @quotation Important You need to do this in a session where no @samp{.org} file has been @@ -619,7 +626,7 @@ page}. @subheading Downloading Org as an archive You can download Org latest release from @uref{https://orgmode.org/, Org's website}. In this case, -make sure you set the load-path correctly in your Emacs init file: +make sure you set the load path correctly in your Emacs init file: @lisp (add-to-list 'load-path "~/path/to/orgdir/lisp") @@ -627,7 +634,7 @@ make sure you set the load-path correctly in your Emacs init file: The downloaded archive contains contributed libraries that are not included in Emacs. If you want to use them, add the @samp{contrib/} -directory to your load-path: +directory to your load path: @lisp (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t) @@ -643,7 +650,7 @@ You can clone Org's repository and install Org like this: @example $ cd ~/src/ -$ git clone git@@code.orgmode.org:bzg/org-mode.git +$ git clone https://code.orgmode.org/bzg/org-mode.git $ cd org-mode/ $ make autoloads @end example @@ -652,7 +659,7 @@ Note that in this case, @samp{make autoloads} is mandatory: it defines Org's version in @samp{org-version.el} and Org's autoloads in @samp{org-loaddefs.el}. -Remember to add the correct load-path as described in the method +Remember to add the correct load path as described in the method above. You can also compile with @samp{make}, generate the documentation with @@ -731,7 +738,9 @@ ideas about it, please send an email to the Org mailing list @email{emacs-orgmode@@gnu.org}. You can subscribe to the list @uref{https://lists.gnu.org/mailman/listinfo/emacs-orgmode, from this web page}. If you are not a member of the mailing list, your mail will be passed to the list after a moderator has approved it@footnote{Please consider subscribing to the mailing list in order to -minimize the work the mailing list moderators have to do.}. +minimize the work the mailing list moderators have to do.}. We ask +you to read and respect the @uref{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind Communications Guidelines} when +sending messages on this mailing list. @findex org-version @findex org-submit-bug-report @@ -827,7 +836,7 @@ or, from the menu: Org @arrow{} Refresh/Reload @arrow{} Reload Org uncompiled. Then, activate the debugger: @example -M-x toggle-debug-or-error +M-x toggle-debug-on-error @end example @@ -925,13 +934,13 @@ the entire show and hide functionalities into a single command, @vindex org-special-ctrl-k @vindex org-ctrl-k-protect-subtree -Headlines define the structure of an outline tree. The headlines in -Org start with one or more stars, on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, +Headlines define the structure of an outline tree. Org headlines +start on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and @code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a}, @kbd{C-e}, and @kbd{C-k} in headlines. Note also that clocking only works with headings indented less than 30 -stars.}. For -example: +stars.} with one or more stars followed by +a space. For example: @example * Top level headline @@ -1020,10 +1029,12 @@ Point must be on a headline for this to work@footnote{See, however, the option @ '--------------------------------------' @end example -When @kbd{S-@key{TAB}} is called with a numeric prefix argument N, -the CONTENTS view up to headlines of level N are shown. Note that -inside tables (see @ref{Tables}), @kbd{S-@key{TAB}} jumps to the previous -field instead. +When @kbd{S-@key{TAB}} is called with a numeric prefix argument +@var{N}, view contents only up to headlines of level +@var{N}. + +Note that inside tables (see @ref{Tables}), @kbd{S-@key{TAB}} jumps to the +previous field instead. @vindex org-cycle-global-at-bob You can run global cycling using @kbd{@key{TAB}} only if point is at @@ -1047,9 +1058,9 @@ Show all, including drawers. @kindex C-c C-r @findex org-reveal Reveal context around point, showing the current entry, the -following heading and the hierarchy above. Useful for working near -a location that has been exposed by a sparse tree command (see -@ref{Sparse Trees}) or an agenda command (see @ref{Agenda Commands}). With a prefix argument show, on each level, all sibling +following heading and the hierarchy above. It is useful for working +near a location that has been exposed by a sparse tree command (see +@ref{Sparse Trees}) or an agenda command (see @ref{Agenda Commands}). With a prefix argument, show, on each level, all sibling headings. With a double prefix argument, also show the entire subtree of the parent. @@ -1057,15 +1068,15 @@ subtree of the parent. @cindex show branches, command @kindex C-c C-k @findex outline-show-branches -Expose all the headings of the subtree, CONTENTS view for just one -subtree. +Expose all the headings of the subtree, but not their bodies. @item @kbd{C-c @key{TAB}} (@code{outline-show-children}) @cindex show children, command @kindex C-c TAB @findex outline-show-children Expose all direct children of the subtree. With a numeric prefix -argument N, expose all children down to level N@. +argument @var{N}, expose all children down to level +@var{N}. @item @kbd{C-c C-x b} (@code{org-tree-to-indirect-buffer}) @kindex C-c C-x b @@ -1074,10 +1085,10 @@ Show the current subtree in an indirect buffer@footnote{The indirect buffer cont to the current tree. Editing the indirect buffer also changes the original buffer, but without affecting visibility in that buffer. For more information about indirect buffers, see @ref{Indirect Buffers,GNU Emacs Manual,,emacs,}.}. With -a numeric prefix argument, N, go up to level N and then take that -tree. If N is negative then go up that many levels. With -a @kbd{C-u} prefix, do not remove the previously used indirect -buffer. +a numeric prefix argument @var{N}, go up to level @var{N} +and then take that tree. If @var{N} is negative then go up +that many levels. With a @kbd{C-u} prefix, do not remove the +previously used indirect buffer. @item @kbd{C-c C-x v} (@code{org-copy-visible}) @kindex C-c C-x v @@ -1090,10 +1101,10 @@ Copy the @emph{visible} text in the region into the kill ring. @vindex org-startup-folded When Emacs first visits an Org file, the global state is set to -OVERVIEW, i.e., only the top level headlines are visible@footnote{When @code{org-agenda-inhibit-startup} is non-@code{nil}, Org does not +@code{showeverything}, i.e., all file content is visible@footnote{When @code{org-agenda-inhibit-startup} is non-@code{nil}, Org does not honor the default visibility state when first opening a file for the -agenda (see @ref{Speeding Up Your Agendas}).}. This -can be configured through the variable @code{org-startup-folded}, or on +agenda (see @ref{Speeding Up Your Agendas}).}. This can +be configured through the variable @code{org-startup-folded}, or on a per-file basis by adding one of the following lines anywhere in the buffer: @@ -1270,14 +1281,22 @@ level. Yet another @kbd{@key{TAB}}, and you are back to the initial level. @item @kbd{M-@key{LEFT}} (@code{org-do-promote}) +@itemx @kbd{M-@key{RIGHT}} (@code{org-do-demote}) @kindex M-LEFT @findex org-do-promote -Promote current heading by one level. - -@item @kbd{M-@key{RIGHT}} (@code{org-do-demote}) @kindex M-RIGHT @findex org-do-demote -Demote current heading by one level. +Promote or demote current heading by one level. + +@cindex region, active +@cindex active region +@cindex transient mark mode +When there is an active region---i.e., when Transient Mark mode is +active---promotion and demotion work on all headlines in the region. +To select a region of headlines, it is best to place both point and +mark at the beginning of a line, mark at the beginning of the first +headline, and point at the line just after the last headline to +change. @item @kbd{M-S-@key{LEFT}} (@code{org-promote-subtree}) @kindex M-S-LEFT @@ -1396,16 +1415,8 @@ Finally, if the first line is a headline, remove the stars from all headlines in the region. @end table -@cindex region, active -@cindex active region -@cindex transient mark mode -When there is an active region---i.e., when Transient Mark mode is -active---promotion and demotion work on all headlines in the region. -To select a region of headlines, it is best to place both point and -mark at the beginning of a line, mark at the beginning of the first -headline, and point at the line just after the last headline to -change. Note that when point is inside a table (see @ref{Tables}), the -Meta-Cursor keys have different functionality. +Note that when point is inside a table (see @ref{Tables}), the Meta-Cursor +keys have different functionality. @node Sparse Trees @section Sparse Trees @@ -1481,12 +1492,12 @@ matching the string @samp{FIXME}. The other sparse tree commands select headings based on TODO keywords, tags, or properties and are discussed later in this manual. -@kindex C-c C-e v +@kindex C-c C-e C-v @cindex printing sparse trees @cindex visible text, printing To print a sparse tree, you can use the Emacs command @code{ps-print-buffer-with-faces} which does not print invisible parts of -the document. Or you can use the command @kbd{C-c C-e v} to +the document. Or you can use the command @kbd{C-c C-e C-v} to export only the visible part of the document and print the resulting file. @@ -1560,7 +1571,7 @@ My favorite scenes are (in this order) But in the end, no individual scenes matter but the film as a whole. Important actors in this film are: - Elijah Wood :: He plays Frodo -- Sean Astin :: He plays Sam, Frodo's friend. I still remember him +- Sean Astin :: He plays Sam, Frodo's friend. I still remember him very well from his role as Mikey Walsh in /The Goonies/. @end example @@ -1677,11 +1688,11 @@ bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them on @code{org-plain-list-ordered-item-terminator}, the type of list, and its indentation. With a numeric prefix argument N, select the Nth bullet from this list. If there is an active region when calling -this, selected text is changed into an item. With a prefix -argument, all lines are converted to list items. If the first line -already was a list item, any item marker is removed from the list. -Finally, even without an active region, a normal line is converted -into a list item. +this, all lines are converted to list items. With a prefix +argument, the selected text is changed into a single item. If the +first line already was a list item, any item marker is removed from +the list. Finally, even without an active region, a normal line is +converted into a list item. @item @kbd{C-c *} @kindex C-c * @@ -1812,7 +1823,7 @@ as the first non-whitespace character is considered part of a table. @samp{|} is also the column separator@footnote{To insert a vertical bar into a table field, use @samp{\vert} or, inside a word @samp{abc\vert@{@}def}.}. Moreover, a line starting with @samp{|-} is a horizontal rule. It separates rows explicitly. Rows -before the first horizontal rule are header lines. A table might look +before the first horizontal rule are header lines. A table might look like this: @example @@ -1937,7 +1948,8 @@ Kill the current column. @item @kbd{M-S-@key{RIGHT}} (@code{org-table-insert-column}) @kindex M-S-RIGHT @findex org-table-insert-column -Insert a new column to the left of point position. +Insert a new column at point position. Move the recent column and +all cells to the right of this column to the right. @item @kbd{M-@key{UP}} (@code{org-table-move-row-up}) @kindex M-UP @@ -2121,6 +2133,18 @@ format used to export the file can be configured in the variable name and the format for table export in a subtree. Org supports quite general formats for exported tables. The exporter format is the same as the format used by Orgtbl radio tables, see @ref{Translator functions}, for a detailed description. + +@item @kbd{M-x org-table-header-line-mode} +@findex org-table-header-line-mode +@vindex org-table-header-line-p +Turn on the display of the first data row of the table at point in +the window header line when this first row is not visible anymore in +the buffer. You can activate this minor mode by default by setting +the option @code{org-table-header-line-p} to @code{t}. + +@item @kbd{M-x org-table-transpose-table-at-point} +@findex org-table-transpose-table-at-point +Transpose the table at point and eliminate hlines. @end table @node Column Width and Alignment @@ -2163,12 +2187,12 @@ several columns or display them with a fixed width, regardless of content, as shown in the following example. @example -|---+---------------------+--------| |---+-------…|…| +|---+---------------------+--------| |---+-------…+…| | | <6> | | | | <6> …|…| | 1 | one | some | ----\ | 1 | one …|…| | 2 | two | boring | ----/ | 2 | two …|…| | 3 | This is a long text | column | | 3 | This i…|…| -|---+---------------------+--------| |---+-------…|…| +|---+---------------------+--------| |---+-------…+…| @end example To set the width of a column, one field anywhere in the column may @@ -2396,11 +2420,12 @@ Here are a few examples: @cindex range references @cindex references, to ranges You may reference a rectangular range of fields by specifying two -field references connected by two dots @samp{..}. If both fields are in -the current row, you may simply use @samp{$2..$7}, but if at least one -field is in a different row, you need to use the general @samp{@@ROW$COLUMN} -format at least for the first field, i.e., the reference must start -with @samp{@@} in order to be interpreted correctly. Examples: +field references connected by two dots @samp{..}. The ends are included in +the range. If both fields are in the current row, you may simply use +@samp{$2..$7}, but if at least one field is in a different row, you need to +use the general @samp{@@ROW$COLUMN} format at least for the first field, +i.e., the reference must start with @samp{@@} in order to be interpreted +correctly. Examples: @multitable @columnfractions 0.2 0.8 @item @samp{$1..$3} @@ -2410,7 +2435,7 @@ with @samp{@@} in order to be interpreted correctly. Examples: @item @samp{$<<<..$>>} @tab start in third column, continue to the last but one @item @samp{@@2$1..@@4$3} -@tab six fields between these two fields (same as @samp{A2..C4}) +@tab nine fields between these two fields (same as @samp{A2..C4}) @item @samp{@@-1$-2..@@-1} @tab 3 fields in the row above, starting from 2 columns on the left @item @samp{@@I..II} @@ -2446,7 +2471,7 @@ Insert column number on odd rows, set field to empty on even rows. Copy text or values of each row of column 1 of the table named @var{FOO} into column 2 of the current table. -@item @samp{@@3 = 2 * remote(FOO, @@@@1$$#)} +@item @samp{@@3 = 2 * remote(FOO, @@1$$#)} Insert the doubled value of each column of row 1 of the table named @var{FOO} into row 3 of the current table. @end table @@ -3429,29 +3454,26 @@ or alternatively @cindex escape syntax, for links @cindex backslashes, in links -Some @samp{\} and @samp{]} characters in the @var{LINK} part need to be -``escaped'', i.e., preceded by another @samp{\} character. More -specifically, the following character categories, and only them, must -be escaped, in order: +Some @samp{\}, @samp{[} and @samp{]} characters in the @var{LINK} part need to +be ``escaped'', i.e., preceded by another @samp{\} character. More +specifically, the following characters, and only them, must be +escaped: @enumerate @item -all consecutive @samp{\} characters at the end of the link, +all @samp{[} and @samp{]} characters, @item -any @samp{]} character at the very end of the link, +every @samp{\} character preceding either @samp{]} or @samp{[}, @item -all consecutive @samp{\} characters preceding @samp{][} or @samp{]]} patterns, -@item -any @samp{]} character followed by either @samp{[} or @samp{]}. +every @samp{\} character at the end of the link. @end enumerate @findex org-link-escape -Org takes for granted that such links are correctly escaped. -Functions inserting links (see @ref{Handling Links}) take care of this. -You only need to bother about those rules when inserting directly, or -yanking, a URI within square brackets. When in doubt, you may use the -function @code{org-link-escape}, which turns a link string into its -properly escaped form. +Functions inserting links (see @ref{Handling Links}) properly escape +ambiguous characters. You only need to bother about the rules above +when inserting directly, or yanking, a URI within square brackets. +When in doubt, you may use the function @code{org-link-escape}, which turns +a link string into its escaped form. Once a link in the buffer is complete, with all brackets present, Org changes the display so that @samp{DESCRIPTION} is displayed instead of @@ -3479,29 +3501,32 @@ Literal links. @cindex internal links @cindex links, internal -@cindex targets, for links + +A link that does not look like a URL---i.e., does not start with +a known scheme or a file name---refers to the current document. You +can follow it with @kbd{C-c C-o} when point is on the link, or +with a mouse click (see @ref{Handling Links}). @cindex @samp{CUSTOM_ID}, property -If the link does not look like a URL, it is considered to be internal -in the current file. The most important case is a link like -@samp{[[#my-custom-id]]} which links to the entry with the @samp{CUSTOM_ID} property -@samp{my-custom-id}. You are responsible yourself to make sure these -custom IDs are unique in a file. +Org provides several refinements to internal navigation within +a document. Most notably, a construct like @samp{[[#my-custom-id]]} +specifically targets the entry with the @samp{CUSTOM_ID} property set to +@samp{my-custom-id}. Also, an internal link looking like @samp{[[*Some +section]]} points to a headline with the name @samp{Some section}@footnote{To insert a link targeting a headline, in-buffer completion +can be used. Just type a star followed by a few optional letters into +the buffer and press @kbd{M-@key{TAB}}. All headlines in the current +buffer are offered as completions.}. -Links such as @samp{[[My Target]]} or @samp{[[My Target][Find my target]]} lead to a text search in -the current file. - -The link can be followed with @kbd{C-c C-o} when point is on -the link, or with a mouse click (see @ref{Handling Links}). Links to -custom IDs point to the corresponding headline. The preferred match -for a text link is a @emph{dedicated target}: the same string in double -angular brackets, like @samp{<>}. +@cindex targets, for links +When the link does not belong to any of the cases above, Org looks for +a @emph{dedicated target}: the same string in double angular brackets, like +@samp{<>}. @cindex @samp{NAME}, keyword If no dedicated target exists, the link tries to match the exact name -of an element within the buffer. Naming is done with the @samp{NAME} -keyword, which has to be put in the line before the element it refers -to, as in the following example +of an element within the buffer. Naming is done, unsurprisingly, with +the @samp{NAME} keyword, which has to be put in the line before the element +it refers to, as in the following example @example #+NAME: My Target @@ -3510,12 +3535,15 @@ to, as in the following example | of | four cells | @end example -If none of the above succeeds, Org searches for a headline that is -exactly the link text but may also include a TODO keyword and -tags@footnote{To insert a link targeting a headline, in-buffer completion -can be used. Just type a star followed by a few optional letters into -the buffer and press @kbd{M-@key{TAB}}. All headlines in the current -buffer are offered as completions.}. +@vindex org-link-search-must-match-exact-headline +Ultimately, if none of the above succeeds, Org searches for a headline +that is exactly the link text but may also include a TODO keyword and +tags, or initiates a plain text search, according to the value of +@code{org-link-search-must-match-exact-headline}. + +Note that you must make sure custom IDs, dedicated targets, and names +are unique throughout the document. Org provides a linter to assist +you in the process, if needed. See @ref{Org Syntax}. During export, internal links are used to mark objects and assign them a number. Marked objects are then referenced by links pointing to @@ -3673,7 +3701,7 @@ options: @item @tab @samp{file:projects.org} @item -@tab @samp{file:projects.org::some words} (text search) @footnote{The actual behavior of the search depends on the value of the +@tab @samp{file:projects.org::some words} (text search)@footnote{The actual behavior of the search depends on the value of the variable @code{org-link-search-must-match-exact-headline}. If its value is @code{nil}, then a fuzzy text search is done. If it is @code{t}, then only the exact headline is matched, ignoring spaces and statistic cookies. If @@ -3834,7 +3862,7 @@ user/channel/server under the point. For any other file, the link points to the file, with a search string (see @ref{Search Options}) pointing to the contents of the current line. If there is an active region, the selected -words form the basis of the search string. You can write custom Lisp +words form the basis of the search string. You can write custom Lisp functions to select the search string and perform the search for particular file types (see @ref{Custom Searches}). @@ -3979,10 +4007,9 @@ key bindings for this are really too long; you might want to bind this also to @kbd{M-n} and @kbd{M-p}. @lisp -(add-hook 'org-load-hook - (lambda () - (define-key org-mode-map "\M-n" 'org-next-link) - (define-key org-mode-map "\M-p" 'org-previous-link))) +(with-eval-after-load 'org + (define-key org-mode-map (kbd "M-n") 'org-next-link) + (define-key org-mode-map (kbd "M-p") 'org-previous-link)) @end lisp @end table @@ -4853,8 +4880,8 @@ example. If you use Org mode extensively, you may end up with enough TODO items that it starts to make sense to prioritize them. Prioritizing can be -done by placing a @emph{priority cookie} into the headline of a TODO item, -like this +done by placing a @emph{priority cookie} into the headline of a TODO item +right after the TODO keyword, like this: @example *** TODO [#A] Write letter to Sam Fortune @@ -4865,11 +4892,22 @@ like this By default, Org mode supports three priorities: @samp{A}, @samp{B}, and @samp{C}. @samp{A} is the highest priority. An entry without a cookie is treated as equivalent if it had priority @samp{B}. Priorities make a difference only -for sorting in the agenda (see @ref{Weekly/daily agenda}); outside the +for sorting in the agenda (see @ref{Weekly/daily agenda}). Outside the agenda, they have no inherent meaning to Org mode. The cookies are displayed with the face defined by the variable @code{org-priority-faces}, which can be customized. +You can also use numeric values for priorities, such as + +@example +*** TODO [#1] Write letter to Sam Fortune +@end example + + +When using numeric priorities, you need to set @code{org-priority-highest}, +@code{org-priority-lowest} and @code{org-priority-default} to integers, which +must all be strictly inferior to 65. + Priorities can be attached to any outline node; they do not need to be TODO items. @@ -4895,12 +4933,12 @@ that these keys are also used to modify timestamps (see @ref{Creating Timestamps a discussion of the interaction with shift-selection. @end table -@vindex org-highest-priority -@vindex org-lowest-priority -@vindex org-default-priority +@vindex org-priority-highest +@vindex org-priority-lowest +@vindex org-priority-default You can change the range of allowed priorities by setting the -variables @code{org-highest-priority}, @code{org-lowest-priority}, and -@code{org-default-priority}. For an individual buffer, you may set these +variables @code{org-priority-highest}, @code{org-priority-lowest}, and +@code{org-priority-default}. For an individual buffer, you may set these values (highest, lowest, default) like this (please make sure that the highest priority is earlier in the alphabet than the lowest priority): @@ -4909,6 +4947,13 @@ highest priority is earlier in the alphabet than the lowest priority): #+PRIORITIES: A C B @end example + +Or, using numeric values: + +@example +#+PRIORITIES: 1 10 5 +@end example + @node Breaking Down Tasks @section Breaking Down Tasks into Subtasks @@ -5062,6 +5107,21 @@ this headline and the next---so @emph{not} the entire subtree. If there is no active region, just toggle the checkbox at point. @end itemize +@item @kbd{C-c C-x C-r} (@code{org-toggle-radio-button}) +@kindex C-c C-x C-r +@findex org-toggle-radio-button +@cindex radio button, checkbox as +Toggle checkbox status by using the checkbox of the item at point as +a radio button: when the checkbox is turned on, all other checkboxes +on the same level will be turned off. With a universal prefix +argument, toggle the presence of the checkbox. With a double prefix +argument, set it to @samp{[-]}. + +@findex org-list-checkbox-radio-mode +@kbd{C-c C-c} can be told to consider checkboxes as radio buttons by +setting @samp{#+ATTR_ORG: :radio t} right before the list or by calling +@kbd{M-x org-list-checkbox-radio-mode} to activate this minor mode. + @item @kbd{M-S-@key{RET}} (@code{org-insert-todo-heading}) @kindex M-S-RET @findex org-insert-todo-heading @@ -5550,7 +5610,7 @@ with many examples, see @ref{Matching tags and properties}. A property is a key-value pair associated with an entry. Properties can be set so they are associated with a single entry, with every -entry in a tree, or with every entry in an Org file. +entry in a tree, or with the whole buffer. There are two main applications for properties in Org mode. First, properties are like tags, but with a value. Imagine maintaining @@ -5620,8 +5680,12 @@ disks in a box like this: :END: @end example -If you want to set properties that can be inherited by any entry in -a file, use a line like: +Properties can be inserted on buffer level. That means they apply +before the first headline and can be inherited by all entries in a +file. Property blocks defined before first headline needs to be +located at the top of the buffer, allowing only comments above. + +Properties can also be defined using lines like: @cindex @samp{_ALL} suffix, in properties @cindex @samp{PROPERTY}, keyword @@ -5686,7 +5750,8 @@ necessary, the property drawer is created as well. @findex org-insert-drawer Insert a property drawer into the current entry. The drawer is inserted early in the entry, but after the lines with planning -information like deadlines. +information like deadlines. If before first headline the drawer is +inserted at the top of the drawer after any potential comments. @item @kbd{C-c C-c} (@code{org-property-action}) @kindex C-c C-c @@ -5768,7 +5833,7 @@ not be used as keys in the properties drawer: @item @samp{CLOSED} @tab When was this entry closed? @item @samp{DEADLINE} -@tab The deadline time string, without the angular brackets. +@tab The deadline timestamp. @item @samp{FILE} @tab The filename the entry is located in. @item @samp{ITEM} @@ -5776,7 +5841,7 @@ not be used as keys in the properties drawer: @item @samp{PRIORITY} @tab The priority of the entry, a string with a single letter. @item @samp{SCHEDULED} -@tab The scheduling timestamp, without the angular brackets. +@tab The scheduling timestamp. @item @samp{TAGS} @tab The tags defined directly in the headline. @item @samp{TIMESTAMP} @@ -5805,7 +5870,7 @@ Create a sparse tree with all matching entries. With a @kbd{C-u} prefix argument, ignore headlines that are not a TODO line. -@item @kbd{M-x org-agenda m}, @code{org-tags-view} +@item @kbd{M-x org-agenda m} (@code{org-tags-view}) @kindex m @r{(Agenda dispatcher)} @findex org-tags-view Create a global list of tag/property matches from all agenda files. @@ -5923,14 +5988,6 @@ done by defining a column format line. @node Scope of column definitions @subsubsection Scope of column definitions -To define a column format for an entire file, use a line like: - -@cindex @samp{COLUMNS}, keyword -@example -#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO -@end example - - To specify a format that only applies to a specific tree, add a @samp{COLUMNS} property to the top node of that tree, for example: @@ -5941,6 +5998,16 @@ a @samp{COLUMNS} property to the top node of that tree, for example: :END: @end example +A @samp{COLUMNS} property within a property drawer before first headline +will apply to the entire file. As an addition to property drawers, +keywords can also be defined for an entire file using a line like: + +@cindex @samp{COLUMNS}, keyword +@example +#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO +@end example + + If a @samp{COLUMNS} property is present in an entry, it defines columns for the entry itself, and for the entire subtree below it. Since the column definition is part of the hierarchical structure of the @@ -6098,15 +6165,16 @@ format is taken from the @samp{#+COLUMNS} line or from the variable @code{org-columns-default-format}, and column view is established for the current entry and its subtree. -@item @kbd{r} or @kbd{g} (@code{org-columns-redo}) +@item @kbd{r} or @kbd{g} on a columns view line (@code{org-columns-redo}) @kindex r @kindex g @findex org-columns-redo Recreate the column view, to include recent changes made in the buffer. -@item @kbd{q} (@code{org-columns-quit}) +@item @kbd{C-c C-c} or @kbd{q} on a columns view line (@code{org-columns-quit}) @kindex q +@kindex C-c C-c @findex org-columns-quit Exit column view. @end table @@ -6142,10 +6210,11 @@ invokes the same interface that you normally use to change that property. For example, the tag completion or fast selection interface pops up when editing a @samp{TAGS} property. -@item @kbd{C-c C-c} (@code{org-columns-set-tags-or-toggle}) +@item @kbd{C-c C-c} (@code{org-columns-toggle-or-columns-quit}) @kindex C-c C-c -@findex org-columns-set-tags-or-toggle -When there is a checkbox at point, toggle it. +@findex org-columns-toggle-or-columns-quit +When there is a checkbox at point, toggle it. Else exit column +view. @item @kbd{v} (@code{org-columns-show-value}) @kindex v @@ -6228,6 +6297,14 @@ create a globally unique ID for the current entry and copy it to the kill-ring. @end table +@item @samp{:match} +When set to a string, use this as a tags/property match filter to +select only a subset of the headlines in the scope set by the @code{:id} +parameter. +@end table + + +@table @asis @item @samp{:hlines} When @code{t}, insert an hline after every line. When a number N, insert an hline before each headline with level @code{<= N}. @@ -6257,12 +6334,16 @@ block. The following commands insert or update the dynamic block: @table @asis -@item @kbd{C-c C-x i} (@code{org-insert-columns-dblock}) -@kindex C-c C-x i -@findex org-insert-columns-dblock +@item @code{org-columns-insert-dblock} +@kindex C-c C-x x +@findex org-columns-insert-dblock Insert a dynamic block capturing a column view. Prompt for the scope or ID of the view. +This command can be invoked by calling +@code{org-dynamic-block-insert-dblock} (@kbd{C-c C-x x}) and +selecting ``columnview'' (see @ref{Dynamic Blocks}). + @item @kbd{C-c C-c} @kbd{C-c C-x C-u} (@code{org-dblock-update}) @kindex C-c C-c @kindex C-c C-x C-u @@ -6635,6 +6716,8 @@ can control the calendar fully from the minibuffer: @kindex M-S-RIGHT @kindex M-S-LEFT @kindex RET +@kindex . +@kindex C-. @multitable @columnfractions 0.25 0.55 @item @kbd{@key{RET}} @tab Choose date at point in calendar. @@ -6660,6 +6743,11 @@ can control the calendar fully from the minibuffer: @tab Scroll calendar forward by 3 months. @item @kbd{C-v} @tab Scroll calendar backward by 3 months. +@item @kbd{C-.} +@tab Select today's date@footnote{You can also use the calendar command @kbd{.} to jump to +today's date, but if you are inserting an hour specification for your +timestamp, @kbd{.} will then insert a dot after the hour. By contrast, +@kbd{C-.} will always jump to today's date.} @end multitable @vindex org-read-date-display-live @@ -6899,7 +6987,7 @@ organize such tasks using a so-called repeater in a @samp{DEADLINE}, the @samp{+1m} is a repeater; the intended interpretation is that the task has a deadline on @samp{<2005-10-01>} and repeats itself every (one) month starting from that time. You can use yearly, monthly, weekly, daily -and hourly repeat cookies by using the @samp{y}, @samp{w}, @samp{m}, @samp{d} and @samp{h} +and hourly repeat cookies by using the @samp{y}, @samp{m}, @samp{w}, @samp{d} and @samp{h} letters. If you need both a repeater and a special warning period in a deadline entry, the repeater should come first and the warning period last @@ -6949,8 +7037,8 @@ if you have not paid the rent for three months, marking this entry DONE still keeps it as an overdue deadline. Depending on the task, this may not be the best way to handle it. For example, if you forgot to call your father for 3 weeks, it does not make sense to call him -3 times in a single day to make up for it. Finally, there are tasks -like changing batteries which should always repeat a certain time +3 times in a single day to make up for it. Finally, there are tasks, +like changing batteries, which should always repeat a certain time @emph{after} the last time you did it. For these tasks, Org mode has special repeaters @samp{++} and @samp{.+}. For example: @@ -6972,7 +7060,11 @@ special repeaters @samp{++} and @samp{.+}. For example: ** TODO Check the batteries in the smoke detectors DEADLINE: <2005-11-01 Tue .+1m> - Marking this DONE will shift the date to one month after today. + Marking this DONE shifts the date to one month after today. + +** TODO Wash my hands + DEADLINE: <2019-04-05 08:00 Sun .+1h> + Marking this DONE shifts the date to exactly one hour from now. @end example @vindex org-agenda-skip-scheduled-if-deadline-is-shown @@ -7005,7 +7097,7 @@ recorded. It also computes the total time spent on each subtree@footnote{Clocking only works if all headings are indented with less than 30 stars. This is a hard-coded limitation of @code{lmax} in @code{org-clock-sum}.} of a project. And it remembers a history or tasks -recently clocked, to that you can jump quickly between a number of +recently clocked, so that you can jump quickly between a number of tasks absorbing your time. To save the clock history across Emacs sessions, use: @@ -7174,12 +7266,18 @@ Org mode can produce quite complex reports based on the time clocking information. Such a report is called a @emph{clock table}, because it is formatted as one or several Org tables. -You can insert, or update, a clock table through Org dynamic blocks -insert command (see @ref{Dynamic Blocks}), by pressing @kbd{C-c C-x x c l o c k t a b l e @key{RET}}. When called with a prefix argument, +@table @asis +@item @code{org-clock-report} +@kindex C-c C-x x +@findex org-clock-report +Insert or update a clock table. When called with a prefix argument, jump to the first clock table in the current document and update it. The clock table includes archived trees. -@table @asis +This command can be invoked by calling +@code{org-dynamic-block-insert-dblock} (@kbd{C-c C-x x}) and +selecting ``clocktable'' (see @ref{Dynamic Blocks}). + @item @kbd{C-c C-c} or @kbd{C-c C-x C-u} (@code{org-dblock-update}) @kindex C-c C-c @kindex C-c C-x C-u @@ -7203,7 +7301,7 @@ needs to be in the @samp{#+BEGIN: clocktable} line for this command. If @end table Here is an example of the frame for a clock table as it is inserted -into the buffer with the @kbd{C-c C-x C-r} command: +into the buffer by @code{org-clock-report}: @cindex @samp{BEGIN clocktable} @example @@ -7212,10 +7310,9 @@ into the buffer with the @kbd{C-c C-x C-r} command: @end example @vindex org-clocktable-defaults -The @samp{#+BEGIN} line and specify a number of options to define the -scope, structure, and formatting of the report. Defaults for all -these options can be configured in the variable -@code{org-clocktable-defaults}. +The @samp{#+BEGIN} line contains options to define the scope, structure, +and formatting of the report. Defaults for all these options can be +configured in the variable @code{org-clocktable-defaults}. First there are options that determine which clock entries are to be selected: @@ -7303,9 +7400,9 @@ The starting day of the week. The default is 1 for Monday. The starting day of the month. The default is 1 for the first. @item @samp{:step} -Set to @samp{day}, @samp{week}, @samp{month} or @samp{year} to split the table into -chunks. To use this, either @samp{:block}, or @samp{:tstart} and @samp{:tend} are -required. +Set to @samp{day}, @samp{week}, @samp{semimonth}, @samp{month}, or @samp{year} to split the +table into chunks. To use this, either @samp{:block}, or @samp{:tstart} and +@samp{:tend} are required. @item @samp{:stepskip0} When non-@code{nil}, do not show steps that have zero time. @@ -7540,6 +7637,23 @@ If you only want this from time to time, use three universal prefix arguments with @code{org-clock-in} and two @kbd{C-u C-u} with @code{org-clock-in-last}. +@anchor{Clocking out automatically after some idle time} +@subsubheading Clocking out automatically after some idle time + +@cindex auto clocking out after idle time + +@vindex org-clock-auto-clockout-timer +When you often forget to clock out before being idle and you don't +want to manually set the clocking time to take into account, you can +set @code{org-clock-auto-clockout-timer} to a number of seconds and add +@samp{(org-clock-auto-clockout-insinuate)} to your @samp{.emacs} file. + +When the clock is running and Emacs is idle for more than this number +of seconds, the clock will be clocked out automatically. + +Use @samp{M-x org-clock-toggle-auto-clockout RET} to temporarily turn this +on or off. + @node Effort Estimates @section Effort Estimates @@ -7552,9 +7666,14 @@ to produce offers with quotations of the estimated work effort, you may want to assign effort estimates to entries. If you are also clocking your work, you may later want to compare the planned effort with the actual working time, a great way to improve planning -estimates. Effort estimates are stored in a special property -@samp{EFFORT}. You can set the effort for an entry with the following -commands: +estimates. + +Effort estimates are stored in a special property @samp{EFFORT}. Multiple +formats are supported, such as @samp{3:12}, @samp{1:23:45}, or @samp{1d3h5min}; see +the file @samp{org-duration.el} for more detailed information about the +format. + +You can set the effort for an entry with the following commands: @table @asis @item @kbd{C-c C-x e} (@code{org-set-effort}) @@ -7768,9 +7887,9 @@ Clear the target cache. Caching of refile targets can be turned on by setting @code{org-refile-use-cache}. To make the command see new possible targets, you have to clear the cache with this command. -@item @kbd{C-c M-w} (@code{org-copy}) +@item @kbd{C-c M-w} (@code{org-refile-copy}) @kindex C-c M-w -@findex org-copy +@findex org-refile-copy Copying works like refiling, except that the original note is not deleted. @end table @@ -7861,6 +7980,10 @@ came, its outline path the archiving time etc. Configure the variable @code{org-archive-save-context-info} to adjust the amount of information added. +@vindex org-archive-subtree-save-file-p +When @code{org-archive-subtree-save-file-p} is non-@code{nil}, save the target +archive buffer. + @node Internal archiving @subsection Internal archiving @@ -7925,7 +8048,7 @@ none is found, the command offers to set the @samp{ARCHIVE} tag for the child. If point is @emph{not} on a headline when this command is invoked, check the level 1 trees. -@item @kbd{C-@key{TAB}} (@code{org-force-cycle-archived}) +@item @kbd{C-c C-@key{TAB}} (@code{org-force-cycle-archived}) @kindex C-TAB Cycle a tree even if it is tagged with @samp{ARCHIVE}. @@ -8107,7 +8230,7 @@ going through the interactive template selection, you can create your key binding like this: @lisp -(define-key global-map "\C-cx" +(define-key global-map (kbd "C-c x") (lambda () (interactive) (org-capture nil "x"))) @end lisp @@ -8226,9 +8349,15 @@ file and moves point to the right location. The template for creating the capture item. If you leave this empty, an appropriate default template will be used. Otherwise this is a string with escape codes, which will be replaced depending on -time and context of the capture call. The string with escapes may -be loaded from a template file, using the special syntax @samp{(file - "template filename")}. See below for more details. +time and context of the capture call. You may also get this +template string from a file@footnote{When the file name is not absolute, Org assumes it is relative +to @code{org-directory}.}, or dynamically, from a function +using either syntax: + +@example +(file "/path/to/template-file") +(function FUNCTION-RETURNING-THE-TEMPLATE) +@end example @item properties The rest of the entry is a property list of additional options. @@ -8245,10 +8374,23 @@ When set, do not offer to edit the information, just file it away immediately. This makes sense if the template only needs information that can be added automatically. +@item @code{:jump-to-captured} +When set, jump to the captured entry when finished. + @item @code{:empty-lines} Set this to the number of lines to insert before and after the new item. Default 0, and the only other common value is 1. +@item @code{:empty-lines-after} +Set this to the number of lines that should be inserted after the +new item. Overrides @code{:empty-lines} for the number of lines +inserted after. + +@item @code{:empty-lines-before} +Set this to the number of lines that should be inserted before the +new item. Overrides @code{:empty-lines} for the number lines inserted +before. + @item @code{:clock-in} Start the clock in this item. @@ -8270,9 +8412,10 @@ you can force the same behavior by calling @code{org-capture} with a @kbd{C-1} prefix argument. @item @code{:tree-type} -When @code{week}, make a week tree instead of the month tree, i.e., -place the headings for each day under a heading with the current -ISO week. +Use @code{week} to make a week tree instead of the month-day tree, +i.e., place the headings for each day under a heading with the +current ISO week. Use @code{month} to group entries by month +only. Default is to group entries by day. @item @code{:unnarrowed} Do not narrow the target buffer, simply show the full buffer. @@ -8470,8 +8613,8 @@ See the docstring of the variable for more information. It is often useful to associate reference material with an outline node. Small chunks of plain text can simply be stored in the subtree of a project. Hyperlinks (see @ref{Hyperlinks}) can establish associations -with files that live elsewhere on your computer or in the cloud, like -emails or source code files belonging to a project. +with files that live elsewhere on a local, or even remote, computer, +like emails or source code files belonging to a project. Another method is @emph{attachments}, which are files located in a directory belonging to an outline node. Org uses directories either @@ -8488,18 +8631,19 @@ named by a unique ID of each entry, or by a @samp{DIR} property. @node Attachment defaults and dispatcher @subsection Attachment defaults and dispatcher -By default, org-attach will use ID properties when adding attachments -to outline nodes. This makes working with attachments fully -automated. There is no decision needed for folder-name or location. -ID-based directories are by default located in the @samp{data/} directory, -which lives in the same directory where your Org file lives@footnote{If you move entries or Org files from one directory to +By default, Org attach uses ID properties when adding attachments to +outline nodes. This makes working with attachments fully automated. +There is no decision needed for folder-name or location. ID-based +directories are by default located in the @samp{data/} directory, which +lives in the same directory where your Org file lives@footnote{If you move entries or Org files from one directory to another, you may want to configure @code{org-attach-id-dir} to contain an absolute path.}. -For more control over the setup, see @ref{Attachment options}. When attachments are made using @code{org-attach} a default tag @samp{ATTACH} is added to the node that gets the attachments. +For more control over the setup, see @ref{Attachment options}. + The following commands deal with attachments: @table @asis @@ -8617,11 +8761,11 @@ This option changes that to relative links. @vindex org-attach-use-inheritance By default folders attached to an outline node are inherited from parents according to @code{org-use-property-inheritance}. If one instead -want to set inheritance specifically for org-attach that can be done +want to set inheritance specifically for Org attach that can be done using @code{org-attach-use-inheritance}. Inheriting documents through -the node hierarchy makes a lot of sense in most cases. Especially -since the introduction of @ref{Attachment links}. The following example -shows one use case for attachment inheritance: +the node hierarchy makes a lot of sense in most cases. Especially +when using attachment links (see @ref{Attachment links}). The following +example shows one use case for attachment inheritance: @example * Chapter A ... @@ -8632,11 +8776,11 @@ shows one use case for attachment inheritance: Some text #+NAME: Image 1 -[[Attachment:image 1.jpg]] +[[attachment:image 1.jpg]] @end example Without inheritance one would not be able to resolve the link to -image @samp{1.jpg}, since the link is inside a sub-heading to @samp{Chapter +@samp{image 1.jpg}, since the link is inside a sub-heading to @samp{Chapter A}. Inheritance works the same way for both @samp{ID} and @samp{DIR} property. If @@ -8678,6 +8822,18 @@ structure in any other way. All functions in this list will be tried when resolving existing ID's into paths, to maintain backward compatibility with existing folders in your system. +@item @code{org-attach-store-link-p} +@vindex org-attach-store-link-p +Stores a link to the file that is being attached. The link is +stored in @code{org-stored-links} for later insertion with @kbd{C-c C-l} (see @ref{Handling Links}). Depending on what option is set in +@code{org-attach-store-link-p}, the link is stored to either the original +location as a file link, the attachment location as an attachment +link or to the attachment location as a file link. + +@item @code{org-attach-commands} +@vindex org-attach-commands +List of all commands used in the attach dispatcher. + @item @code{org-attach-expert} @vindex org-attach-expert Do not show the splash buffer with the attach dispatcher when @@ -8723,6 +8879,7 @@ the following to your Emacs config: @cindex attach from Dired @findex org-attach-dired-to-subtree + It is possible to attach files to a subtree from a Dired buffer. To use this feature, have one window in Dired mode containing the file(s) to be attached and another window with point in the subtree that shall @@ -9006,9 +9163,11 @@ to specify the number of context lines for each match, default is @end enumerate @item @kbd{#} -@itemx @kbd{!} Create a list of stuck projects (see @ref{Stuck projects}). +@item @kbd{!} +Configure the list of stuck projects (see @ref{Stuck projects}). + @item @kbd{<} @kindex < @r{(Agenda dispatcher)} Restrict an agenda command to the current buffer@footnote{For backward compatibility, you can also press @kbd{1} to @@ -9756,7 +9915,7 @@ then applied to the view and persists as a basic filter through refreshes and more secondary filtering. The filter is a global property of the entire agenda view---in a block agenda, you should only set this in the global options section, not in the section of an -individual block.}. You can switch quickly between +individual block.}. You can switch quickly between different filters without having to recreate the agenda. @emph{Limits} on the other hand take effect before the agenda buffer is populated, so they are mostly useful when defined as local variables within custom @@ -9804,7 +9963,7 @@ again by pressing @kbd{<}. @item @kbd{=} (@code{org-agenda-filter-by-regexp}) @findex org-agenda-filter-by-regexp Filter the agenda view by a regular expression: only show agenda -entries matching the regular expression the user entered. To clear +entries matching the regular expression the user entered. To clear the filter, call the command again by pressing @kbd{=}. @item @kbd{_} (@code{org-agenda-filter-by-effort}) @@ -9846,17 +10005,18 @@ in a single string, with full completion support. For example, +work-John+<0:10-/plot/ @end example -selects entries with category `work' and effort estimates below 10 -minutes, and deselects entries with tag `John' or matching the -regexp `plot'. `+' can be left out if that does not lead to + +selects entries with category @samp{work} and effort estimates below 10 +minutes, and deselects entries with tag @samp{John} or matching the +regexp @samp{plot}. You can leave @samp{+} out if that does not lead to ambiguities. The sequence of elements is arbitrary. The filter -syntax assumes that there is no overlap between categories and tags -(tags will take priority). If you reply to the prompt with the +syntax assumes that there is no overlap between categories and tags. +Otherwise, tags take priority. If you reply to the prompt with the empty string, all filtering is removed. If a filter is specified, -it replaces all current filters. But if you call the command with a -double prefix argument, or if you add an additional `+' -(e.g. `++work') to the front of the string, the new filter elements -are added to the active ones. A single prefix argument applies the +it replaces all current filters. But if you call the command with +a double prefix argument, or if you add an additional @samp{+} (e.g., +@samp{++work}) to the front of the string, the new filter elements are +added to the active ones. A single prefix argument applies the entire filter in a negative sense. @item @kbd{|} (@code{org-agenda-filter-remove-all}) @@ -9867,35 +10027,34 @@ Remove all filters in the current agenda view. @subsubheading Computed tag filtering @vindex org-agenda-auto-exclude-function -If the variable @code{org-agenda-auto-exclude-function} is set to a -user-defined function, that function can select tags that should be +If the variable @code{org-agenda-auto-exclude-function} is set to +a user-defined function, that function can select tags that should be used as a tag filter when requested. The function will be called with -lower-case versions of all tags represented in the current view. The -function should the return @samp{"-tag"} if the filter should remove +lower-case versions of all tags represented in the current view. The +function should return @samp{"-tag"} if the filter should remove entries with that tag, @samp{"+tag"} if only entries with this tag should -be kept, or @samp{nil} if that tag is irrelevant. For example, let's say +be kept, or @samp{nil} if that tag is irrelevant. For example, let's say you use a @samp{Net} tag to identify tasks which need network access, an @samp{Errand} tag for errands in town, and a @samp{Call} tag for making phone calls. You could auto-exclude these tags based on the availability of the Internet, and outside of business hours, with something like this: @lisp -(defun org-my-auto-exclude-fn (tag) - (if (cond - ((string= tag "net") - (/= 0 (call-process "/sbin/ping" nil nil nil - "-c1" "-q" "-t1" "mail.gnu.org"))) - ((member tag '("errand" "call")) - (let ((hr (nth 2 (decode-time)))) - (or (< hr 8) (> hr 21))))) - (concat "-" tag))) +(defun my-auto-exclude-fn (tag) + (when (cond ((string= tag "net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((member tag '("errand" "call")) + (let ((hr (nth 2 (decode-time)))) + (or (< hr 8) (> hr 21))))) + (concat "-" tag))) -(setq org-agenda-auto-exclude-function 'org-my-auto-exclude-fn) +(setq org-agenda-auto-exclude-function #'my-auto-exclude-fn) @end lisp -You can apply this self-adapting filter by using a double prefix -argument to @code{org-agenda-filter}, i.e. press @kbd{C-u C-u /}, or -by pressing @kbd{@key{RET}} in @code{org-agenda-filter-by-tag}. +You can apply this self-adapting filter by using a triple prefix +argument to @code{org-agenda-filter}, i.e.@tie{}press @kbd{C-u C-u C-u /}, +or by pressing @kbd{@key{RET}} in @code{org-agenda-filter-by-tag}. @anchor{Setting limits for the agenda} @subsubheading Setting limits for the agenda @@ -10294,7 +10453,7 @@ both in the agenda buffer and in the remote buffer. @kindex t @findex org-agenda-todo Change the TODO state of the item, both in the agenda and in the -original Org file. A prefix arg is passed through to the @code{org-todo} +original Org file. A prefix arg is passed through to the @code{org-todo} command, so for example a @kbd{C-u} prefix are will trigger taking a note to document the state change. @@ -10371,11 +10530,6 @@ Set the priority for the current item. Org mode prompts for the priority character. If you reply with @kbd{@key{SPC}}, the priority cookie is removed from the entry. -@item @kbd{P} (@code{org-agenda-show-priority}) -@kindex P -@findex org-agenda-show-priority -Display weighted priority of current item. - @item @kbd{+} or @kbd{S-@key{UP}} (@code{org-agenda-priority-up}) @kindex + @kindex S-UP @@ -10390,6 +10544,12 @@ in the original buffer, but the agenda is not resorted. Use the @findex org-agenda-priority-down Decrease the priority of the current item. +@item @kbd{C-c C-x e} or short @kbd{e} (@code{org-agenda-set-effort}) +@kindex e +@kindex C-c C-x e +@findex org-agenda-set-effort +Set the effort property for the current item. + @item @kbd{C-c C-z} or short @kbd{z} (@code{org-agenda-add-note}) @kindex z @kindex C-c C-z @@ -10807,8 +10967,10 @@ Another possibility is the construction of agenda views that comprise the results of @emph{several} commands, each of which creates a block in the agenda buffer. The available commands include @code{agenda} for the daily or weekly agenda (as created with @kbd{a}) , @code{alltodo} for -the global TODO list (as constructed with @kbd{t}), and the +the global TODO list (as constructed with @kbd{t}), @code{stuck} for +the list of stuck projects (as obtained with @kbd{#}) and the matching commands discussed above: @code{todo}, @code{tags}, and @code{tags-todo}. + Here are two examples: @lisp @@ -11249,6 +11411,13 @@ get in your way. Configure the variable @code{org-use-sub-superscripts} to change this convention. For example, when setting this variable to @code{@{@}}, @samp{a_b} is not interpreted as a subscript, but @samp{a_@{b@}} is. +You can set @code{org-use-sub-superscripts} in a file using the export +option @samp{^:} (see @ref{Export Settings}). For example, @samp{#+OPTIONS: ^:@{@}} +sets @code{org-use-sub-superscripts} to @code{@{@}} and limits super- and +subscripts to the curly bracket notation. + +You can also toggle the visual display of super- and subscripts: + @table @asis @item @kbd{C-c C-x \} (@code{org-toggle-pretty-entities}) @kindex C-c C-x \ @@ -11256,6 +11425,13 @@ change this convention. For example, when setting this variable to This command formats sub- and superscripts in a WYSIWYM way. @end table +@vindex org-pretty-entities +@vindex org-pretty-entities-include-sub-superscripts +Set both @code{org-pretty-entities} and +@code{org-pretty-entities-include-sub-superscripts} to @code{t} to start with +super- and subscripts @emph{visually} interpreted as specified by the +option @code{org-use-sub-superscripts}. + @node Special Symbols @section Special Symbols @@ -11892,7 +12068,7 @@ back-ends: @end itemize Users can install libraries for additional formats from the Emacs -packaging system. For easy discovery, these packages have a common +packaging system. For easy discovery, these packages have a common naming scheme: @code{ox-NAME}, where @var{NAME} is a format. For example, @code{ox-koma-letter} for @emph{koma-letter} back-end. More libraries can be found in the @samp{contrib/} directory (see @ref{Installation}). @@ -12068,9 +12244,7 @@ The email address (@code{user-mail-address}). Language to use for translating certain strings (@code{org-export-default-language}). With @samp{#+LANGUAGE: fr}, for example, Org translates @samp{Table of contents} to the French @samp{Table des - matières}@footnote{For export to @LaTeX{} format---or @LaTeX{}-related formats such as -Beamer---, the @samp{org-latex-package-alist} variable needs further -configuration. See @ref{@LaTeX{} specific export settings}.}. + matières}@footnote{DEFINITION NOT FOUND@.}. @item @samp{SELECT_TAGS} @cindex @samp{SELECT_TAGS}, keyword @@ -13400,7 +13574,7 @@ following lines before the table in the Org file: @cindex @samp{ATTR_HTML}, keyword @example #+CAPTION: This is a table with lines around and between cells -#+ATTR_HTML: border="2" rules="all" frame="border" +#+ATTR_HTML: :border 2 :rules all :frame border @end example The HTML export back-end preserves column groupings in Org tables (see @@ -13696,17 +13870,15 @@ simpler ways of customizing as described above. @subsection JavaScript supported display of web pages Sebastian Rose has written a JavaScript program especially designed to -enhance the web viewing experience of HTML files created with Org. -This program enhances large files in two different ways of viewing. -One is an @emph{Info}-like mode where each section is displayed separately -and navigation can be done with the @kbd{n} and @kbd{p} -keys, and some other keys as well, press @kbd{?} for an overview -of the available keys. The second one has a @emph{folding} view, much like -Org provides inside Emacs. The script is available at -@uref{https://orgmode.org/org-info.js} and the documentation at -@uref{https://orgmode.org/worg/code/org-info-js/}. The script is hosted on -@uref{https://orgmode.org}, but for reliability, prefer installing it on your -own web server. +allow two different ways of viewing HTML files created with Org. One +is an @emph{Info}-like mode where each section is displayed separately and +navigation can be done with the @kbd{n} and @kbd{p} keys, and some other +keys as well, press @kbd{?} for an overview of the available keys. The +second one has a @emph{folding} view, much like Org provides inside Emacs. +The script is available at @uref{https://orgmode.org/org-info.js} and the +documentation at @uref{https://orgmode.org/worg/code/org-info-js/}. The +script is hosted on @uref{https://orgmode.org}, but for reliability, prefer +installing it on your own web server. To use this program, just add this line to the Org file: @@ -16270,6 +16442,33 @@ tables and lists in foreign buffers. For example, in an HTML buffer, write a list in Org syntax, select it, and convert it to HTML with @kbd{M-x org-html-convert-region-to-html}. +@menu +* Bare HTML:: Exporting HTML without CSS, Javascript, etc. +@end menu + +@node Bare HTML +@subsection Exporting to minimal HTML + +If you want to output a minimal HTML file, with no CSS, no Javascript, +no preamble or postamble, here are the variable you would need to set: + +@vindex org-html-head +@vindex org-html-head-extra +@vindex org-html-head-include-default-style +@vindex org-html-head-include-scripts +@vindex org-html-preamble +@vindex org-html-postamble +@vindex org-html-use-infojs +@lisp +(setq org-html-head "" + org-html-head-extra "" + org-html-head-include-default-style nil + org-html-head-include-scripts nil + org-html-preamble nil + org-html-postamble nil + org-html-use-infojs nil) +@end lisp + @node Publishing @chapter Publishing @@ -16655,6 +16854,8 @@ any, during publishing. Options set within a file (see @ref{Export Settings}), @tab @code{org-html-mathjax-options} @item @code{:html-mathjax-template} @tab @code{org-html-mathjax-template} +@item @code{:html-equation-reference-format} +@tab @code{org-html-equation-reference-format} @item @code{:html-metadata-timestamp-format} @tab @code{org-html-metadata-timestamp-format} @item @code{:html-postamble-format} @@ -17170,6 +17371,34 @@ Here is an example source code block in the Emacs Lisp language: #+END_SRC @end example +Source code blocks are one of many Org block types, which also include +``center'', ``comment'', ``dynamic'', ``example'', ``export'', ``quote'', +``special'', and ``verse''. This section pertains to blocks between +@samp{#+BEGIN_SRC} and @samp{#+END_SRC}. + +Details of Org's facilities for working with source code are described +in the following sections. + +@menu +* Features Overview:: Enjoy the versatility of source blocks. +* Structure of Code Blocks:: Code block syntax described. +* Using Header Arguments:: Different ways to set header arguments. +* Environment of a Code Block:: Arguments, sessions, working directory... +* Evaluating Code Blocks:: Place results of evaluation in the Org buffer. +* Results of Evaluation:: Choosing a results type, post-processing... +* Exporting Code Blocks:: Export contents and/or results. +* Extracting Source Code:: Create pure source code files. +* Languages:: List of supported code block languages. +* Editing Source Code:: Language major-mode editing. +* Noweb Reference Syntax:: Literate programming in Org mode. +* Library of Babel:: Use and contribute to a library of useful code blocks. +* Key bindings and Useful Functions:: Work quickly with code blocks. +* Batch Execution:: Call functions from the command line. +@end menu + +@node Features Overview +@section Features Overview + Org can manage the source code in the block delimited by @samp{#+BEGIN_SRC} @dots{} @samp{#+END_SRC} in several ways that can simplify housekeeping tasks essential to modern source code maintenance. Org can edit, format, @@ -17178,13 +17407,7 @@ and execute a source code block, then capture the results. The Org mode literature sometimes refers to source code blocks as @emph{live code} blocks because they can alter the content of the Org document or the material that it exports. Users can control how live they want each -source code block by tweaking the header arguments (see @ref{Using Header Arguments}) for compiling, execution, extraction, and -exporting. - -Source code blocks are one of many Org block types, which also include -``center'', ``comment'', ``dynamic'', ``example'', ``export'', ``quote'', -``special'', and ``verse''. This section pertains to blocks between -@samp{#+BEGIN_SRC} and @samp{#+END_SRC}. +source code block by tweaking the header arguments (see @ref{Using Header Arguments}) for compiling, execution, extraction, and exporting. For editing and formatting a source code block, Org uses an appropriate Emacs major mode that includes features specifically @@ -17222,25 +17445,6 @@ configuration settings of the execution environment, the results of the execution, and associated narratives, claims, references, and internal and external links in a single Org document. -Details of Org's facilities for working with source code are described -in the following sections. - -@menu -* Structure of Code Blocks:: Code block syntax described. -* Using Header Arguments:: Different ways to set header arguments. -* Environment of a Code Block:: Arguments, sessions, working directory... -* Evaluating Code Blocks:: Place results of evaluation in the Org buffer. -* Results of Evaluation:: Choosing a results type, post-processing... -* Exporting Code Blocks:: Export contents and/or results. -* Extracting Source Code:: Create pure source code files. -* Languages:: List of supported code block languages. -* Editing Source Code:: Language major-mode editing. -* Noweb Reference Syntax:: Literate programming in Org mode. -* Library of Babel:: Use and contribute to a library of useful code blocks. -* Key bindings and Useful Functions:: Work quickly with code blocks. -* Batch Execution:: Call functions from the command line. -@end menu - @node Structure of Code Blocks @section Structure of Code Blocks @@ -17989,7 +18193,7 @@ variable @code{org-babel-inline-result-wrap}, which by default is set to This is the name of the code block (see @ref{Structure of Code Blocks}) to be evaluated in the current document. If the block is located in another file, start @samp{} with the file name followed by -a colon. For example, in order to execute a block named @samp{clear-data} +a colon. For example, in order to execute a block named @samp{clear-data} in @samp{file.org}, you can write the following: @example @@ -18081,8 +18285,8 @@ A note of warning: when @samp{cache} is used in a session, caching may cause unexpected results. When the caching mechanism tests for any source code changes, it does -not expand Noweb style references (see @ref{Noweb Reference Syntax}). For -reasons why, see @uref{http://thread.gmane.org/gmane.emacs.orgmode/79046}. +not expand noweb style references (see @ref{Noweb Reference Syntax}). For +reasons why, see @uref{https://orgmode.org/list/86fvqqc8jb.fsf@@somewhere.org} The @samp{cache} header argument can have one of two values: @samp{yes} or @samp{no}. @@ -18156,20 +18360,20 @@ they are mutually exclusive. @table @asis @item @samp{value} -Default. Functional mode. Org gets the value by wrapping the code -in a function definition in the language of the source block. That -is why when using @samp{:results value}, code should execute like -a function and return a value. For languages like Python, an -explicit @code{return} statement is mandatory when using @samp{:results - value}. Result is the value returned by the last statement in the -code block. +Default for most Babel libraries@footnote{Actually, the constructs @samp{call_()} and @samp{src_@{@}} +are not evaluated when they appear in a keyword (see @ref{In-buffer Settings}).}. Functional mode. Org +gets the value by wrapping the code in a function definition in the +language of the source block. That is why when using @samp{:results + value}, code should execute like a function and return a value. For +languages like Python, an explicit @code{return} statement is mandatory +when using @samp{:results value}. Result is the value returned by the +last statement in the code block. When evaluating the code block in a session (see @ref{Environment of a Code Block}), Org passes the code to an interpreter running as an -interactive Emacs inferior process. Org gets the value from the +interactive Emacs inferior process. Org gets the value from the source code interpreter's last statement output. Org has to use language-specific methods to obtain the value. For example, from -the variable @code{_} in Python and Ruby, and the value of @code{.Last.value} -in R@. +the variable @code{_} in Ruby, and the value of @code{.Last.value} in R@. @item @samp{output} Scripting mode. Org passes the code to an external process running @@ -18179,41 +18383,6 @@ stream as text results. When using a session, Org passes the code to the interpreter running as an interactive Emacs inferior process. Org concatenates any text output from the interpreter and returns the collection as a result. - -Note that this collection is not the same as that would be collected -from stdout of a non-interactive interpreter running as an external -process. Compare for example these two blocks: - -@example -#+BEGIN_SRC python :results output - print "hello" - 2 - print "bye" -#+END_SRC - -#+RESULTS: -: hello -: bye -@end example - -In the above non-session mode, the ``2'' is not printed; so it does -not appear in results. - -@example -#+BEGIN_SRC python :results output :session - print "hello" - 2 - print "bye" -#+END_SRC - -#+RESULTS: -: hello -: 2 -: bye -@end example - -In the above session, the interactive interpreter receives and -prints ``2''. Results show that. @end table @anchor{Type} @@ -18313,14 +18482,25 @@ and the extension are mandatory. @cindex @samp{file-desc}, header argument The @samp{file-desc} header argument defines the description (see -@ref{Link Format}) for the link. If @samp{file-desc} has no value, Org -uses the generated file name for both the ``link'' and -``description'' parts of the link. +@ref{Link Format}) for the link. If @samp{file-desc} is present but has no value, +the @samp{file} value is used as the link description. When this +argument is not present, the description is omitted. @cindex @samp{sep}, header argument By default, Org assumes that a table written to a file has TAB-delimited output. You can choose a different separator with the @samp{sep} header argument. + +@cindex @samp{file-mode}, header argument +The @samp{file-mode} header argument defines the file permissions. To +make it executable, use @samp{:file-mode (identity #o755)}. + +@example +#+BEGIN_SRC shell :results file :file script.sh :file-mode (identity #o755) + echo "#!/bin/bash" + echo "echo Hello World" +#+END_SRC +@end example @end table @anchor{Format} @@ -18350,13 +18530,13 @@ Results enclosed in a @samp{BEGIN_EXPORT latex} block. Usage example: @item @samp{link} @itemx @samp{graphics} -Result is a link to the file specified in @samp{:file} header argument. -However, unlike plain @samp{:file}, nothing is written to the disk. The -block is used for its side-effects only, as in the following -example: +When used along with @samp{file} type, the result is a link to the file +specified in @samp{:file} header argument. However, unlike plain @samp{file} +type, nothing is written to the disk. The block is used for its +side-effects only, as in the following example: @example -#+begin_src shell :results link :file "download.tar.gz" +#+begin_src shell :results file link :file "download.tar.gz" wget -c "http://example.com/download.tar.gz" #+end_src @end example @@ -18558,7 +18738,7 @@ code. When Org tangles 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 tangling process, Org -expands variables in the source code, and resolves any Noweb style +expands variables in the source code, and resolves any noweb style references (see @ref{Noweb Reference Syntax}). @anchor{Header arguments} @@ -18616,7 +18796,7 @@ the source block. Includes both @samp{link} and @samp{org} options. @item @samp{noweb} -Includes @samp{link} option, expands Noweb references (see @ref{Noweb Reference Syntax}), and wraps them in link comments inside the body +Includes @samp{link} option, expands noweb references (see @ref{Noweb Reference Syntax}), and wraps them in link comments inside the body of the code block. @end table @@ -18655,7 +18835,7 @@ By default Org expands code blocks during tangling. The @samp{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 (see @ref{Environment of a Code Block}) to variables. Expansions also replace -Noweb references with their targets (see @ref{Noweb Reference Syntax}). +noweb references with their targets (see @ref{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 code blocks for execution have to be @@ -18716,7 +18896,7 @@ file. Code blocks in the following languages are supported. -@multitable @columnfractions 0.20 0.35 0.20 0.20 +@multitable @columnfractions 0.25 0.25 0.25 0.20 @headitem Language @tab Identifier @tab Language @@ -18916,11 +19096,13 @@ for Python and Emacs Lisp languages. @node Noweb Reference Syntax @section Noweb Reference Syntax -@cindex code block, Noweb reference -@cindex syntax, Noweb -@cindex source code, Noweb reference +@cindex code block, noweb reference +@cindex syntax, noweb +@cindex source code, noweb reference -Org supports named blocks in Noweb@footnote{For Noweb literate programming details, see +@cindex @samp{noweb-ref}, header argument +Source code blocks can include references to other source code blocks, +using a noweb@footnote{For noweb literate programming details, see @uref{http://www.cs.tufts.edu/~nr/noweb/}.} style syntax: @example @@ -18928,42 +19110,48 @@ Org supports named blocks in Noweb@footnote{For Noweb literate programming detai @end example -Org can replace the construct with the source code, or the results of -evaluation, of the code block identified as @var{CODE-BLOCK-ID}. +@noindent +where @var{CODE-BLOCK-ID} refers to either the @samp{NAME} of a single +source code block, or a collection of one or more source code blocks +sharing the same @samp{noweb-ref} header argument (see @ref{Using Header Arguments}). Org can replace such references with the source code of +the block or blocks being referenced, or, in the case of a single +source code block named with @samp{NAME}, with the results of an evaluation +of that block. @cindex @samp{noweb}, header argument -The @samp{noweb} header argument controls expansion of Noweb syntax +The @samp{noweb} header argument controls expansion of noweb syntax references. Expansions occur when source code blocks are evaluated, tangled, or exported. @table @asis @item @samp{no} -Default. No expansion of Noweb syntax references in the body of the +Default. No expansion of noweb syntax references in the body of the code when evaluating, tangling, or exporting. @item @samp{yes} -Expansion of Noweb syntax references in the body of the code block +Expansion of noweb syntax references in the body of the code block when evaluating, tangling, or exporting. @item @samp{tangle} -Expansion of Noweb syntax references in the body of the code block +Expansion of noweb syntax references in the body of the code block when tangling. No expansion when evaluating or exporting. @item @samp{no-export} -Expansion of Noweb syntax references in the body of the code block +Expansion of noweb syntax references in the body of the code block when evaluating or tangling. No expansion when exporting. @item @samp{strip-export} -Expansion of Noweb syntax references in the body of the code block -when expanding prior to evaluating or tangling. Removes Noweb +Expansion of noweb syntax references in the body of the code block +when expanding prior to evaluating or tangling. Removes noweb syntax references when exporting. @item @samp{eval} -Expansion of Noweb syntax references in the body of the code block +Expansion of noweb syntax references in the body of the code block only before evaluating. @end table -In the following example, +In the most simple case, the contents of a single source block is +inserted within other blocks. Thus, in following example, @example #+NAME: initialization @@ -18987,10 +19175,105 @@ the second code block is expanded as #+END_SRC @end example -Noweb insertions honor prefix characters that appear before the Noweb +You may also include the contents of multiple blocks sharing a common +@samp{noweb-ref} header argument, which can be set at the file, sub-tree, +or code block 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 when tangled. + +@example +#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh + <> +#+END_SRC +* the mount point of the fullest disk + :PROPERTIES: + :header-args: :noweb-ref fullest-disk + :END: + +** query all mounted disks +#+BEGIN_SRC sh + df \ +#+END_SRC + +** strip the header row +#+BEGIN_SRC sh + |sed '1d' \ +#+END_SRC + +** output mount point of fullest disk +#+BEGIN_SRC sh + |awk '@{if (u < +$5) @{u = +$5; m = $6@}@} END @{print m@}' +#+END_SRC +@end example + +@cindex @samp{noweb-sep}, header argument +By default a newline separates each noweb reference concatenation. To +use a different separator, edit the @samp{noweb-sep} header argument. + +Alternatively, Org can include the results of evaluation of a single +code block rather than its body. Evaluation occurs when parentheses, +possibly including arguments, are appended to the code block name, as +shown below. + +@example +<> +@end example + + +Note that in this case, a code block name set by @samp{NAME} keyword is +required; the reference set by @samp{noweb-ref} will not work when +evaluation is desired. + +Here is an example that demonstrates how the exported content changes +when noweb style references are used with parentheses versus without. +Given: + +@example +#+NAME: some-code +#+BEGIN_SRC python :var num=0 :results output :exports none + print(num*10) +#+END_SRC +@end example + +@noindent +this code block: + +@example +#+BEGIN_SRC text :noweb yes + <> +#+END_SRC +@end example + +@noindent +expands to: + +@example +print(num*10) +@end example + + +Below, a similar noweb style reference is used, but with parentheses, +while setting a variable @samp{num} to 10: + +@example +#+BEGIN_SRC text :noweb yes + <> +#+END_SRC +@end example + +@noindent +Note that the expansion now contains the results of the code block +@samp{some-code}, not the code block itself: + +@example +100 +@end example + + +Noweb insertions honor prefix characters that appear before the noweb syntax reference. This behavior is illustrated in the following -example. Because the @samp{<>} Noweb reference appears behind the -SQL comment syntax, each line of the expanded Noweb reference is +example. Because the @samp{<>} noweb reference appears behind the +SQL comment syntax, each line of the expanded noweb reference is commented. With: @example @@ -19020,8 +19303,8 @@ expands to: #+END_SRC @end example -Since this change does not affect Noweb replacement text without -newlines in them, inline Noweb references are acceptable. +Since this change does 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: @@ -19060,102 +19343,17 @@ else: print('do things when false') @end example -@cindex @samp{noweb-ref}, header argument -When expanding Noweb style references, Org concatenates code blocks by -matching the reference name to either the code block name or, if none -is found, to the @samp{noweb-ref} header argument. +When in doubt about the outcome of a source code block expansion, you +can preview the results with the following command: -For simple concatenation, set this @samp{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 when tangled. - -@example -#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh - <> -#+END_SRC -* the mount point of the fullest disk - :PROPERTIES: - :header-args: :noweb-ref fullest-disk - :END: - -** query all mounted disks -#+BEGIN_SRC sh - df \ -#+END_SRC - -** strip the header row -#+BEGIN_SRC sh - |sed '1d' \ -#+END_SRC - -** output mount point of fullest disk -#+BEGIN_SRC sh - |awk '@{if (u < +$5) @{u = +$5; m = $6@}@} END @{print m@}' -#+END_SRC -@end example - -@cindex @samp{noweb-sep}, header argument -By default a newline separates each noweb reference concatenation. To -change this newline separator, edit the @samp{noweb-sep} header argument. - -Eventually, Org can include the results of a code block rather than -its body. To that effect, append parentheses, possibly including -arguments, to the code block name, as shown below. - -@example -<> -@end example - - -Note that when using the above approach to a code block's results, the -code block name set by @samp{NAME} keyword is required; the reference set -by @samp{noweb-ref} does not work in that case. - -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 - -@noindent -this code block: - -@example -#+BEGIN_SRC text :noweb yes - <> -#+END_SRC -@end example - -@noindent -expands to: - -@example -print(num*10) -@end example - - -Below, a similar Noweb style reference is used, but with parentheses, -while setting a variable @samp{num} to 10: - -@example -#+BEGIN_SRC text :noweb yes - <> -#+END_SRC -@end example - -@noindent -Note that now the expansion contains the results of the code block -@samp{some-code}, not the code block itself: - -@example -100 -@end example +@table @asis +@item @kbd{C-c C-v v} or @kbd{C-c C-v C-v} (@code{org-babel-expand-src-block}) +@findex org-babel-expand-src-block +@kindex C-c C-v v +@kindex C-c C-v C-v +Expand the current source code block according to its header +arguments and pop open the results in a preview buffer. +@end table @node Library of Babel @section Library of Babel @@ -19358,12 +19556,13 @@ emacs -Q --batch --eval " * Structure Templates:: Quick insertion of structural elements. * Speed Keys:: Electric commands at the beginning of a headline. * Clean View:: Getting rid of leading stars in the outline. +* Execute commands in the active region:: Execute commands on multiple items in Org or agenda view. * Dynamic Headline Numbering:: Display and update outline numbering. * The Very Busy @kbd{C-c C-c} Key:: When in doubt, press @kbd{C-c C-c}. * In-buffer Settings:: Overview of keywords. * Org Syntax:: Formal description of Org's syntax. * Documentation Access:: Read documentation about current syntax. -* Escape Character:: +* Escape Character:: Prevent Org from interpreting your writing. * Code Evaluation Security:: Org files evaluate in-line code. * Interaction:: With other Emacs packages. * TTY Keys:: Using Org on a tty. @@ -19411,10 +19610,6 @@ At the beginning of an empty headline, complete TODO keywords. @item After @samp{\}, complete @TeX{} symbols supported by the exporter. -@item -After @samp{*}, complete headlines in the current buffer so that they -can be used in search links like: @samp{[[*find this headline]]} - @item After @samp{:} in a headline, complete tags. Org deduces the list of tags from the @samp{TAGS} in-buffer option (see @ref{Setting Tags}), the @@ -19427,7 +19622,11 @@ of keys is constructed dynamically from all keys used in the current buffer. @item -After @samp{[}, complete link abbreviations (see @ref{Link Abbreviations}). +After @samp{[[}, complete link abbreviations (see @ref{Link Abbreviations}). + +@item +After @samp{[[*}, complete headlines in the current buffer so that they +can be used in search links like: @samp{[[*find this headline]]} @item After @samp{#+}, complete the special keywords like @samp{TYP_TODO} or @@ -19581,9 +19780,16 @@ through @code{word-wrap}.}. @vindex org-indent-indentation-per-level To make more horizontal space, the headlines are shifted by two characters. Configure @code{org-indent-indentation-per-level} variable for -a different number. Only one star on each headline is visible, the -rest are masked with the same font color as the background@footnote{Note that turning on Org Indent mode sets -@code{org-hide-leading-stars} to @code{t} and @code{org-adapt-indentation} to @code{nil}.}. +a different number. + +@vindex org-indent-mode-turns-on-hiding-stars +@vindex org-indent-mode-turns-off-org-adapt-indentation +By default, Org Indent mode turns off @code{org-adapt-indentation} and does +hide leading stars by locally setting @code{org-hide-leading-stars} to @code{t}: +only one star on each headline is visible, the rest are masked with +the same font color as the background. If you want to customize this +default behavior, see @code{org-indent-mode-turns-on-hiding-stars} and +@code{org-indent-mode-turns-off-org-adapt-indentation}. @vindex org-startup-indented To globally turn on Org Indent mode for all files, customize the @@ -19602,7 +19808,9 @@ It is possible to use hard spaces to achieve the indentation instead, if the bare ASCII file should have the indented look also outside Emacs@footnote{This works, but requires extra effort. Org Indent mode is more convenient for most applications.}. With Org's support, you have to indent all lines to -line up with the outline headers. You would use these settings: +line up with the outline headers. You would use these +settings@footnote{@code{org-adapt-indentation} can also be set to @samp{'headline-data}, +in which case only data lines below the headline will be indented.}: @lisp (setq org-adapt-indentation t @@ -19632,7 +19840,7 @@ face @code{org-hide} to them. For per-file preference, use these file @item @emph{Odd levels} (@code{org-odd-levels-only}) @vindex org-odd-levels-only The third setting makes Org use only odd levels, 1, 3, 5, @dots{}, in -the outline to create more indentation. On a per-file level, +the outline to create more indentation. On a per-file level, control this with: @example @@ -19644,6 +19852,26 @@ To convert a file between single and double stars layouts, use @kbd{M-x org-convert-to-odd-levels} and @kbd{M-x org-convert-to-oddeven-levels}. @end table +@node Execute commands in the active region +@section Execute commands in the active region + +@vindex org-loop-over-headlines-in-active-region +When in an Org buffer and the region is active, some commands will +apply to all the subtrees in the active region. For example, hitting +@kbd{C-c C-s} when multiple headlines are within the active region will +successively prompt you for a new schedule date and time. To disable +this, set the option @code{org-loop-over-headlines-in-active-region} to +non-@code{t}, activate the region and run the command normally. + +@vindex org-agenda-loop-over-headlines-in-active-region +@code{org-agenda-loop-over-headlines-in-active-region} is the equivalent +option of the agenda buffer, where you can also use @ref{Bulk remote editing selected entries, , bulk editing of +selected entries}. + +Not all commands can loop in the active region and what subtrees or +headlines are considered can be refined: see the docstrings of these +options for more details. + @node Dynamic Headline Numbering @section Dynamic Headline Numbering @@ -19672,6 +19900,11 @@ If @code{org-num-skip-footnotes} is non-@code{nil}, footnotes sections (see You can control how the numbering is displayed by setting @code{org-num-face} and @code{org-num-format-function}. +@vindex org-startup-numerated +You can also turn this mode globally for all Org files by setting the +option @code{org-startup-numerated} to @samp{t}, or locally on a file by using +@samp{#+startup: num}. + @node The Very Busy @kbd{C-c C-c} Key @section The Very Busy @kbd{C-c C-c} Key @@ -19684,6 +19917,9 @@ combination in Org. Its uses are well documented throughout this manual, but here is a consolidated list for easy reference. @itemize +@item +If column view (see @ref{Column View}) is on, exit column view. + @item If any highlights shown in the buffer from the creation of a sparse tree, or from clock display, remove such highlights. @@ -19754,7 +19990,7 @@ Closing and reopening the Org file in Emacs also activates the changes. @table @asis -@item @samp{#+ARCHIVE: %s_done} +@item @samp{#+ARCHIVE: %s_done::} @cindex @samp{ARCHIVE}, keyword @vindex org-archive-location Sets the archive location of the agenda file. The corresponding @@ -19794,9 +20030,9 @@ corresponding variable is @code{org-link-abbrev-alist}. @item @samp{#+PRIORITIES: highest lowest default} @cindex @samp{PRIORITIES}, keyword -@vindex org-highest-priority -@vindex org-lowest-priority -@vindex org-default-priority +@vindex org-priority-highest +@vindex org-priority-lowest +@vindex org-priority-default This line sets the limits and the default for the priorities. All three must be either letters A--Z or numbers 0--9. The highest priority must have a lower ASCII number than the lowest priority. @@ -19828,8 +20064,8 @@ Startup options Org uses when first visiting a file. @vindex org-startup-folded The first set of options deals with the initial visibility of the outline tree. The corresponding variable for global default -settings is @code{org-startup-folded} with a default value of @code{t}, which -is the same as @code{overview}. +settings is @code{org-startup-folded} with a default value of +@code{showeverything}. @multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaa} @item @samp{overview} @@ -19855,6 +20091,17 @@ wraps long lines, including headlines, correctly indented.}. @tab Start with Org Indent mode turned off. @end multitable +@vindex org-startup-numerated +Dynamic virtual numeration of headlines is controlled by the variable +@code{org-startup-numerated}. + +@multitable {aaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@item @samp{num} +@tab Start with Org num mode turned on. +@item @samp{nonum} +@tab Start with Org num mode turned off. +@end multitable + @vindex org-startup-align-all-tables Aligns tables consistently upon visiting a file. The corresponding variable is @code{org-startup-align-all-tables} with @@ -20117,8 +20364,10 @@ using it on a headline displays ``Document Structure'' section. @cindex zero width space You may sometimes want to write text that looks like Org syntax, but should really read as plain text. Org may use a specific escape -character in some situations, e.g., a backslash in macros (see @ref{Macro Replacement}) or a comma in source and example blocks (see @ref{Literal Examples}). In the general case, however, we suggest to use the zero -width space. You can insert one with any of the following: +character in some situations, i.e., a backslash in macros (see @ref{Macro Replacement}) and links (see @ref{Link Format}), or a comma in source and +example blocks (see @ref{Literal Examples}). In the general case, however, +we suggest to use the zero width space. You can insert one with any +of the following: @example C-x 8 zero width space @@ -20618,8 +20867,8 @@ javascript:location.href='org-protocol://capture?template=x'+ @vindex org-protocol-default-template-key The capture template to be used can be specified in the bookmark (like -@samp{X} above). If unspecified, the template key is set in the variable -@code{org-protocol-default-template-key}. The following template +@samp{X} above). If unspecified, the template key is set in the variable +@code{org-protocol-default-template-key}. The following template placeholders are available: @example @@ -20779,13 +21028,11 @@ compatible with Org Mobile. It also describes synchronizing changes, such as to notes, between the mobile application and the computer. To change tags and TODO states in the mobile application, first -customize the variables @code{org-todo-keywords} and @code{org-tag-alist}. -These should cover all the important tags and TODO keywords, even if -Org files use only some of them. Though the mobile application is -expected to support in-buffer settings, it is required to understand -TODO states @emph{sets} (see @ref{Per-file keywords}) and -@emph{mutually exclusive} tags (see @ref{Setting Tags}) only for those set in -these variables. +customize the variables @code{org-todo-keywords}, @code{org-tag-alist} and +@code{org-tag-persistent-alist}. These should cover all the important tags +and TODO keywords, even if Org files use only some of them. Though +the mobile application is expected to support in-buffer settings, it +is required to understand TODO states @emph{sets} (see @ref{Per-file keywords}) and @emph{mutually exclusive} tags (see @ref{Setting Tags}) only for those set in these variables. @menu * Setting up the staging area:: For the mobile device. @@ -20967,14 +21214,14 @@ process of adding Org links to Unix man pages, which look like this @noindent -The following @samp{org-man.el} file implements it +The following @samp{ol-man.el} file implements it @lisp -;;; org-man.el - Support for links to man pages in Org mode -(require 'org) +;;; ol-man.el - Support for links to man pages in Org mode +(require 'ol) (org-link-set-parameters "man" - :follow org-man-command + :follow #'org-man-open :export #'org-man-export :store #'org-man-store-link) @@ -20983,6 +21230,11 @@ The following @samp{org-man.el} file implements it :group 'org-link :type '(choice (const man) (const woman))) +(defun org-man-open (path _) + "Visit the manpage on PATH. +PATH should be a topic that can be thrown at the man command." + (funcall org-man-command path)) + (defun org-man-store-link () "Store a link to a man page." (when (memq major-mode '(Man-mode woman-mode)) @@ -20990,7 +21242,7 @@ The following @samp{org-man.el} file implements it (let* ((page (org-man-get-page-name)) (link (concat "man:" page)) (description (format "Man page for %s" page))) - (org-store-link-props + (org-link-store-props :type "man" :link link :description description)))) @@ -21002,7 +21254,7 @@ The following @samp{org-man.el} file implements it (match-string 1 (buffer-name)) (error "Cannot create link to this man page"))) -(defun org-man-export (link description format) +(defun org-man-export (link description format _) "Export a man page link from Org files." (let ((path (format "http://man.he.net/?topic=%s§ion=all" link)) (desc (or description link))) @@ -21013,8 +21265,8 @@ The following @samp{org-man.el} file implements it (`ascii (format "%s (%s)" desc path)) (t path)))) -(provide 'org-man) -;;; org-man.el ends here +(provide ol-man) +;;; ol-man.el ends here @end lisp @noindent @@ -21022,15 +21274,15 @@ To activate links to man pages in Org, enter this in the Emacs init file: @lisp -(require 'org-man) +(require 'ol-man) @end lisp @noindent -A review of @samp{org-man.el}: +A review of @samp{ol-man.el}: @enumerate @item -First, @samp{(require 'org)} ensures @samp{org.el} is loaded. +First, @samp{(require 'ol)} ensures that @samp{ol.el} is loaded. @item @findex org-link-set-parameters @@ -21385,7 +21637,7 @@ Update all dynamic blocks in the current file. Before updating a dynamic block, Org removes content between the @samp{BEGIN} and @samp{END} markers. Org then reads the parameters on the -@samp{BEGIN} line for passing to the writer function as a plist. The +@samp{BEGIN} line for passing to the writer function as a plist. The previous content of the dynamic block becomes erased from the buffer and appended to the plist under @code{:content}. @@ -21987,7 +22239,7 @@ a JavaScript program for displaying webpages derived from Org using an Info-like or a folding interface with single-key navigation. @end table -See below for the full list of contributions! Again, please let me +See below for the full list of contributions! Again, please let me know what I am missing here! @anchor{From Bastien} @@ -22044,7 +22296,7 @@ be complete if the ones above were not mentioned in this manual. @itemize @item -Russel Adams came up with the idea for drawers. +Russell Adams came up with the idea for drawers. @item Thomas Baumann wrote @samp{ol-bbdb.el} and @samp{ol-mhe.el}. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index ce08496b20b..0c094411ab0 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -10,6 +10,546 @@ See the end of the file for license conditions. Please send Org bug reports to mailto:emacs-orgmode@gnu.org. +* Version 9.4 +** Incompatible changes +*** Possibly broken internal file links: please check and fix + +A bug has been affecting internal links to headlines, like + +: [[*Headline][A link to a headline]] + +Storing a link to a headline may have been broken in your setup and +those links may appear as + +: [[*TODO Headline][A link to a headline]] + +Following the link above will result in an error: the TODO keyword +should not be part of internal file links. + +You can use the following command to fix links in an Org buffer: + +#+begin_src emacs-lisp +(defun org-fix-links () + "Fix ill-formatted internal links. +E.g. replace [[*TODO Headline][headline]] by [[*Headline][headline]]. +Go through the buffer and ask for the replacement." + (interactive) + (visible-mode 1) + (save-excursion + (goto-char (point-min)) + (let ((regexp (format "\\[\\[\\*%s\\s-+" + (regexp-opt org-todo-keywords-1 t)))) + (while (re-search-forward regexp nil t) + (when (and (save-excursion + (goto-char (match-beginning 0)) + (looking-at-p org-link-bracket-re)) + (y-or-n-p "Fix link (remove TODO keyword)? ")) + (replace-match "[[*"))))) + (visible-mode -1)) +#+end_src + +*** Calling conventions changes when opening or exporting custom links + +This changes affects export back-ends, and libraries providing new +link types. + +Function used in ~:follow~ link parameter is required to accept a +second argument. Likewise, function used in ~:export~ parameter needs +to accept a fourth argument. See ~org-link-set-parameters~ for +details. + +Eventually, the function ~org-export-custom-protocol-maybe~ is now +called with a fourth argument. Even though the 3-arguments definition +is still supported, at least for now, we encourage back-end developers +to switch to the new signature. + +*** Python session return values must be top-level expression statements + +Python blocks with ~:session :results value~ header arguments now only +return a value if the last line is a top-level expression statement. +Also, when a None value is returned, "None" will be printed under +"#+RESULTS:", as it already did with ~:results value~ for non-session +blocks. + +*** In HTML export, change on how outline-container-* is set + +When the headline has a =CUSTOM_ID=, use this custom id to build the +div id. For example, if you have =:CUSTOM_ID: my-headline= then the +resulting
will be ~
~. + +You may want to check whether your HTML files are rendered differently +after this change. + +*** New keybinding == for ~org-force-cycle-archived~ + +~org-force-cycle-archived~ used to be associated with == but +this keybinding is used in Emacs for navigating tabs in Emacs. The +new keybinding is ==. + +** New default settings for some options + +These options now default to =t=: + +- ~org-loop-over-headlines-in-active-region~ +- ~org-fontify-done-headline~ +- ~org-src-tab-acts-natively~ + +You may want to read the docstrings of these options to understand the +consequences of this change. + +Also, ~org-startup-folded~ now defaults to ~showeverything~. + +** New features + +*** Looping agenda commands over headlines + +~org-agenda-loop-over-headlines-in-active-region~ allows you to loop +agenda commands over the active region. + +When set to =t= (the default), loop over all headlines. When set to +='start-level=, loop over headlines with the same level as the first +headline in the region. When set to a string, loop over lines +matching this regular expression. + +*** New minor mode ~org-table-header-line-mode~ + +Turn on the display of the first data row of the table at point in the +window header line when this first row is not visible anymore in the +buffer. + +You can activate this minor mode by default by setting the option +~org-table-header-line-p~ to =t=. You can also change the face for +the header line by customizing the ~org-table-header~ face. + +*** New minor mode ~org-list-checkbox-radio-mode~ + +When this minor mode is on, checkboxes behave as radio buttons: if a +checkbox is turned on, other checkboxes at the same level are turned +off. + +If you want to occasionally toggle a checkbox as a radio button +without turning this minor mode on, you can use == to +call ~org-toggle-radio-button~. + +You can also add =#+ATTR_ORG: :radio t= right before the list to tell +Org to use radio buttons for this list only. + +*** New allowed value for ~org-adapt-indentation~ + +~org-adapt-indentation~ now accepts a new value, ='headline-data=. + +When set to this value, Org will only adapt indentation of headline +data lines, such as planning/clock lines and property/logbook drawers. +Also, with this setting, =org-indent-mode= will keep these data lines +correctly aligned with the headline above. + +*** Numeric priorities are now allowed (up to 65) + +You can now set ~org-priority-highest/lowest/default~ to integers to +use numeric priorities globally or set, for example + +#+PRIORITIES: 1 10 5 + +to define a buffer-local range and default for priorities. Priority +commands should work as usual. You cannot use numbers superior to 64 +for numeric priorities, as it would clash with priorities like [#A] +where the "A" is internally converted to its numeric value of 65. + +*** Property drawers allowed before first headline + +Property drawers are now allowed before the first headline. + +Org mode is moving more towards making things before the first +headline behave just as if it was at outline level 0. Inheritance for +properties will work also for this level. In other words: defining +things in a property drawer before the first headline will make them +"inheritable" for all headlines. + +*** Refinement in window behavior on exiting Org source buffer + +After editing a source block, Org will restore the window layout when +~org-src-window-setup~ is set to a value that modifies the layout. + +*** Display remote inline images + +Org now knows how to display remote images inline. + +Whether the images are actually displayed is controlled by the new +option ~org-display-remote-inline-images~. + +*** New option to resolve open clock at a provided time + +~org-resolve-clocks~ now has a `t' option, which works just like the +`k' option, but the user specifies a time of day, not a number of +minutes. + +*** New step value =semimonth= accepted for clock tables + +*** Allow text rescaling in column view + +You can now use =C-x C-+= in column view: the columns face size will +increase or decrease, together with the column header size. + +*** New startup option =#+startup: num= + +When this startup option is set, display headings as numerated. + +Use =#+startup: nonum= to turn this off. + +*** New tool for custom links + +Org provides a new tool ~org-link-open-as-file~, useful when defining +new link types similar to "file"-type links. See docstring for +details. + +*** New optional numeric argument for ~org-return~ + +In situations where ~org-return~ calls ~newline~, multiple newlines +can now be inserted with this prefix argument. + +*** New source code block header argument =:file-mode= + +Source code block header argument =:file-mode= can set file +permissions if =:file= argument is provided. + +*** =RET= and =C-j= now obey ~electric-indent-mode~ + +Since Emacs 24.4, ~electric-indent-mode~ is enabled by default. In +most major modes, this causes =RET= to reindent the current line and +indent the new line, and =C-j= to insert a newline without indenting. + +Org mode now obeys this minor mode: when ~electric-indent-mode~ is +enabled, and point is neither in a table nor on a timestamp or a link: + +- =RET= (bound to ~org-return~) reindents the current line and indents + the new line; +- =C-j= (bound to the new command ~org-return-and-maybe-indent~) + merely inserts a newline. + +To get the previous behaviour back, disable ~electric-indent-mode~ +explicitly: + +#+begin_src emacs-lisp +(add-hook 'org-mode-hook (lambda () (electric-indent-local-mode -1))) +#+end_src + +Alternatively, if you wish to keep =RET= as the "smart-return" key, +but dislike Org's default indentation of sections, you may prefer to +customize ~org-adapt-indentation~ to either =nil= or ='headline-data=. + +*** =ob-C.el= allows the inclusion of non-system header files + +In C and C++ blocks, ~:includes~ arguments that do not start with a +~<~ character will now be formatted as double-quoted ~#include~ +statements. + +*** =ob-clojure.el= supports inf-clojure.el and ClojureScript evaluation + +You can now set ~(setq org-babel-clojure-backend 'inf-clojure)~ and +evaluate Clojure source blocks using [[https://github.com/clojure-emacs/inf-clojure][inf-clojure]]. With a header +argument like =:alias "alias"= the Clojure REPL will boot with +=clojure -Aalias=. Otherwise Clojure will boot with =lein=, =boot= or +=tools.deps=, depending on whether the current directory contains a +=project.clj=, =build.boot= or =deps.edn=, falling back on +~inf-clojure-generic-cmd~ in case no such file is present. + +Also, when using [[https://github.com/clojure-emacs/cider][cider]], you can now use =#+begin_src clojurescript= to +execute ClojureScript code from Org files. Note that this works only +if your Org file is associated with a cider session that knows how to +run ClojureScript code. A bare =lein repl= session outside of a +directory configured for ClojureScript will /not/ work. + +*** =ob-java.el= supports Java command line arguments + +Babel Java blocks recognize header argument =:cmdargs= and pass its +value in call to =java=. + +*** =ob-screen.el= now accepts =:screenrc= header argument + +Screen blocks now recognize the =:screenrc= header argument and pass +its value to the screen command via the "-c" option. The default +remains =/dev/null= (i.e. a clean screen session) + +*** =ob-plantuml=: now supports using PlantUML executable to generate diagrams + +Set =org-plantuml-exec-mode= to ='plantuml= in order to use the +executable instead of JAR. When using an executable it is also +possible to configure executable location as well as arguments via: +=org-plantuml-executable-path= and =org-plantuml-executable-args=. + +** New commands +*** ~org-table-header-line-mode~ + +Turn on a minor mode to display the first data row of the table at +point in the header-line when the beginning of the table is invisible. + +*** ~org-agenda-ctrl-c-ctrl-c~ + +Hitting == in an agenda view now calls ~org-agenda-set-tags~. + +*** ~org-hide-entry~ + +This command is the counterpart of ~org-show-entry~. + +*** ~org-columns-toggle-or-columns-quit~ + +== bound to ~org-columns-toggle-or-columns-quit~ replaces the +recent ~org-columns-set-tags-or-toggle~. Tag setting is still +possible via column view value edit or with ==. + +*** ~org-datetree-find-month-create~ + +Find or create a month entry for a date. + +** New options and settings +*** New option ~org-html-prefer-user-labels~ + +When non-nil, use =NAME= affiliated keyword, or raw target values, to +generate anchor's ID. Otherwise, consistently use internal naming +scheme. + +=CUSTOM_ID= values are still always used, when available. +*** New option for using tabs in ~org-agenda-window-setup~ + +Choosing ~other-tab~ for ~org-agenda-window-setup~ will open the +agenda view in a new tab. This will work with versions of Emacs since +27.1 when ~tab-bar-mode~ was introduced. + +*** New option ~org-table-header-line-p~ + +Setting this option to =t= will activate ~org-table-header-line-mode~ +in org-mode buffers. + +*** New option ~org-startup-numerated~ + +When this option is =t=, Org files will start using ~(org-num-mode 1)~ +and headings will be visually numerated. + +You can turn this on/off on a per-file basis with =#+startup: num= or +=#+startup: nonum=. + +*** New option ~org-clock-auto-clockout-timer~ + +When this option is set to a number and the user configuration +contains =(org-clock-auto-clockout-insinuate)=, Org will clock out the +currently clocked in task after that number of seconds of idle time. + +This is useful when you often forget to clock out before being idle +and don't want to have to manually set the clocking time to take into +account. + +*** New option to group captured datetime entries by month + +A new `:tree-type month' option was added to org-capture-templates to +group new datetime entries by month. + +*** New option to show source buffers using "plain" display-buffer + +There is a new option ~plain~ to ~org-src-window-setup~ to show source +buffers using ~display-buffer~. This allows users to control how +source buffers are displayed by modifying ~display-buffer-alist~ or +~display-buffer-base-action~. + +*** New option ~org-archive-subtree-save-file-p~ + +Archiving a subtree used to always save the target archive buffer. +Commit [[https://code.orgmode.org/bzg/org-mode/commit/b186d1d7][b186d1d7]] changed this behavior by always not saving the target +buffer, because batch archiving from agenda could take too much time. + +This new option ~org-archive-subtree-save-file-p~ defaults to the +value =from-org= so that archiving a subtree will save the target +buffer when done from an org-mode buffer, but not from the agenda. +You can also set this option to =t= or to =from-agenda=. + +*** New option ~org-show-notification-timeout~ + +This option will add a timeout to notifications. + +*** New option ~org-latex-to-html-convert-command~ + +This new option allows you to convert a LaTeX fragment directly into +HTML. + +*** New option ~org-babel-shell-results-defaults-to-output~ + +By default, source code blocks are executed in "functional mode": it +means that the results of executing them are the value of their last +statement (see [[https://orgmode.org/manual/Results-of-Evaluation.html][the documentation]].) + +The value of a shell script's execution is its exit code. But most +users expect the results of executing a shell script to be its output, +not its exit code. + +So we introduced this option, that you can set to =nil= if you want +to stick using ~:results value~ as the implicit header. + +In all Babel libraries, the absence of a ~:results~ header should +produce the same result than setting ~:results value~, unless there is +an option to explicitly create an exception. + +See [[https://orgmode.org/list/CA+A2iZaziAfMeGpBqL6qGrzrWEVvLvC0DUw++T4gCF3NGuW-DQ@mail.gmail.com/][this thread]] for more context. + +*** New option in ~org-attach-store-link-p~ + +~org-attach-store-link-p~ has a new option to store a file link to the +attachment. +*** New option ~org-fontify-todo-headline~ + +This feature is the same as ~org-fontify-done-headline~, but for TODO +headlines instead. This allows you to distinguish TODO headlines from +normal headlines. The face can be customized via ~org-headline-todo~. + +*** New default value for ~org-file-apps~ + +The new value uses Emacs as the application for opening directory. + +*** New hook ~org-agenda-filter-hook~ + +Functions in this hook are run after ~org-agenda-filter~ is called. + +** Removed or renamed functions and variables +*** Deprecated ~org-flag-drawer~ function + +Use ~org-hide-drawer-toggle~ instead. + +*** Deprecated ~org-hide-block-toggle-maybe~ function + +Use ~org-hide-block-toggle~ instead. + +*** Deprecated ~org-hide-block-toggle-all~ function + +This function was not used in the code base, and has no clear use +either. It has been marked for future removal. Please contact the +mailing list if you use this function. + +*** Deprecated ~org-return-indent~ function + +In Elisp code, use ~(org-return t)~ instead. Interactively, =C-j= is +now bound to ~org-return-and-maybe-indent~, which indents the new line +when ~electric-indent-mode~ is disabled. + +*** Removed ~org-maybe-keyword-time-regexp~ + +The variable was not used in the code base. + +*** Removed ~org-export-special-keywords~ + +The variable was not used in the code base. + +*** Renamed ~org-at-property-block-p~ + +The new name is ~org-at-property-drawer-p~, which is less confusing. + +*** Renamed ~org-columns-set-tags-or-toggle~ + +See [[*~org-columns-toggle-or-columns-quit~]]. + +*** Renamed priority options + +From ~org-lowest-priority~ to ~org-priority-lowest~. +From ~org-default-priority~ to ~org-priority-default~. +From ~org-highest-priority~ to ~org-priority-highest~. +From ~org-enable-priority-commands~ to ~org-priority-enable-commands~. +From ~org-show-priority~ to ~org-priority-show~. + +** Miscellaneous +*** =ob-screen.el= now respects screen =:session= name + +Screen babel session are now named based on the =:session= header +argument (defaults to ~default~). + +Previously all session names had ~org-babel-session-~ prepended. + +*** Forward/backward paragraph functions in line with the rest of Emacs + +~org-forward-paragraph~ and ~org-backward-paragraph~, bound to +~~ and ~~ functions mimic more closely behaviour of +~forward-paragraph~ and ~backward-paragraph~ functions when +available. + +They also accept an optional argument for multiple calls. + +See their docstring for details. +*** ~org-table-to-lisp~ no longer checks if point is at a table + +The caller is now responsible for the check. It can use, e.g., +~org-at-table-p~. + +The function is also much more efficient than it used to be, even on +very large tables. + +*** New function ~org-collect-keywords~ +*** Drawers' folding use an API similar to block's + +Tooling for folding drawers interactively or programmatically is now +on par with block folding. In particular, ~org-hide-drawer-toggle~, +a new function, is the central place for drawer folding. + +*** Duration can be read and written in compact form + +~org-duration-to-minutes~ understands =1d3h5min= as a duration, +whereas ~org-duration-from-minutes~ can output this compact form if +the duration format contains the symbol ~compact~. + +*** C-n, C-p, SPC and DEL in agenda commands dispatch window + +You can now use ==, ==, == and == key to scroll up +and down the agenda and attach dispatch window. + +*** == in agenda calls ~org-agenda-set-tags~ + +Both == and == set the tags of the headline in the +Org buffer. Both keybindings are now available from the agenda too. + +*** Allow to use an empty HTML extension + +Using =(setq org-html-extension "")= or setting the HTML extension in +any fashion will produce the expected output, with no trailing period +to the resulting HTML file. + +*** Handle repeated tasks with =.+= type and hours step + +A task using a =.+= repeater and hours step is repeated starting from +now. E.g., + +#+begin_example +,,** TODO Wash my hands + DEADLINE: <2019-04-05 08:00 Sun .+1h> + Marking this DONE shifts the date to exactly one hour from now. +#+end_example + +*** The format of equation reference in HTML export can now be specified + +By default, HTML (via MathJax) and LaTeX export equation references +using different commands. LaTeX must use ~\ref{%s}~ because it is used +for all labels; however, HTML (via MathJax) uses ~\eqref{%s}~ for +equations producing inconsistent output. New option +~org-html-equation-reference-format~ sets the command used in HTML +export. + +*** =ob-haskell.el= supports compilation with =:compile= header argument + +By default, Haskell blocks are interpreted. By adding =:compile yes= +to a Haskell source block, it will be compiled, executed and the +results will be displayed. + +*** Support for ~org-edit-special~ with LaTeX fragments + +Calling ~org-edit-special~ on an inline LaTeX fragment calls a new +function, ~org-edit-latex-fragment~. This functions in a comparable +manner to editing inline source blocks, bringing up a minibuffer set +to LaTeX mode. The math-mode deliminators are read only. + +*** ~org-capture-current-plist~ is now accessible during ~org-capture-mode-hook~ +*** New =org-refile.el= file + +Org refile variables and functions have been moved to a new file. + +*** The end of a 7 years old bug + +This bug [[https://lists.gnu.org/archive/html/emacs-orgmode/2013-08/msg00072.html][originally reported]] by Matt Lundin and investigated by Andrew +Hyatt has been fixed. Thanks to both of them. + * Version 9.3 ** Incompatible changes @@ -19,15 +559,11 @@ Org used to percent-encode sensitive characters in the URI part of the bracket links. Now, escaping mechanism uses the usual backslash character, according -to the following rules, applied in order: +to the following rules: -1. All consecutive =\= characters at the end of the link must be - escaped; -2. Any =]= character at the very end of the link must be escaped; -3. All consecutive =\= characters preceding =][= or =]]= patterns must - be escaped; -4. Any =]= character followed by either =[= or =]= must be escaped; -5. Others =]= and =\= characters need not be escaped. +1. All =[= and =]= characters in the URI must be escaped; +2. Every =\= character preceding either =[= or =]= must be escaped; +3. Every =\= character at the end of the URI must be escaped. When in doubt, use the function ~org-link-escape~ in order to turn a link string into its properly escaped form. @@ -141,7 +677,7 @@ Export ignore done tasks with a deadline when Likewise, scheduled done tasks are also ignored when ~org-icalendar-use-scheduled~ contains the same symbol. -*** Add split-window-right option for src block edit window placement +*** Add ~split-window-right~ option for src block edit window placement Given the increasing popularity of wide screen monitors, splitting horizontally may make more sense than splitting vertically. An @@ -364,7 +900,6 @@ the headline to use for making the table of contents. ,* Another section ,#+TOC: headlines 1 :target "#TargetSection" #+end_example - ** New functions *** ~org-dynamic-block-insert-dblock~ @@ -474,6 +1009,16 @@ I.e. treat the whole file as if it was a subtree. *** Respect narrowing when agenda command is restricted to buffer +*** ~org-table-insert-column~ inserts the column at point position + +Before, the new column was inserted to the right of the column at +point position. + +*** Table column deletion now consistent with row deletion + +Point stays in the column at deletion, except when deleting the +rightmost column. + * Version 9.2 ** Incompatible changes *** Removal of OrgStruct mode mode and radio lists @@ -484,7 +1029,7 @@ and ~org-list-radio-lists-templates~) are removed from the code base. Note that only radio /lists/ have been removed, not radio tables. If you want to manipulate lists like in Org in other modes, we suggest -to use orgalist.el, which you can install from GNU ELPA. +to use =orgalist.el=, which you can install from GNU ELPA. If you want to use Org folding outside of Org buffers, you can have a look at the outshine package in the MELPA repository. @@ -1276,9 +1821,9 @@ removed from Gnus circa September 2010. *** ~org-agenda-repeating-timestamp-show-all~ is removed. -For an equivalent to a ~nil~ value, set +For an equivalent to a =nil= value, set ~org-agenda-show-future-repeats~ to nil and -~org-agenda-prefer-last-repeat~ to ~t~. +~org-agenda-prefer-last-repeat~ to =t=. *** ~org-gnus-nnimap-query-article-no-from-file~ is removed. @@ -1296,7 +1841,7 @@ equivalent to the removed format string. *** ~org-enable-table-editor~ is removed. -Setting it to a ~nil~ value broke some other features (e.g., speed +Setting it to a =nil= value broke some other features (e.g., speed keys). *** ~org-export-use-babel~ cannot be set to ~inline-only~ @@ -1377,16 +1922,20 @@ is now obsolete. Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use ~@verb{}~ again by customizing the variable. + *** Texinfo exports example blocks as ~@example~ *** Texinfo exports inline source blocks as ~@code{}~ *** Texinfo default table markup is ~@asis~ + It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more suitable as a default value. + *** Texinfo default process includes ~--no-split~ option *** New entities : ~\dollar~ and ~\USD~ *** Support for date style URLs in =org-protocol://open-source= - URLs like =https://cool-blog.com/2017/05/20/cool-post/= are - covered by rewrite rules. + +URLs like =https://cool-blog.com/2017/05/20/cool-post/= are covered by +rewrite rules. *** Add (C) =COMMENT= support to ~org-structure-template-alist~ @@ -1476,7 +2025,7 @@ Moreover, ~:export-block~ keyword used in ~org-export-define-backend~ and ~org-export-define-derived-backend~ is no longer used and needs to be removed. -*** Footnotes +*** Footnotes changes **** [1]-like constructs are not valid footnotes @@ -2216,7 +2765,7 @@ without changing the headline. *** Hierarchies of tags -The functionality of nesting tags in hierarchies is added to org-mode. +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". @@ -4105,7 +4654,7 @@ See https://orgmode.org/elpa/ You can temporarily activate continuous clocking with =C-u C-u C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments) - and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix + and =C-u C-u M-x= [[doc::org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix arguments). @@ -4581,7 +5130,7 @@ that Calc formulas can operate on them. The new system has a technically cleaner implementation and more possibilities for capturing different types of data. See - [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's announcement]] for more details. + [[https://orgmode.org/list/C46F10DC-DE51-43D4-AFFE-F71E440D1E1F@gmail.com][Carsten's announcement]] for more details. To switch over to the new system: @@ -4712,7 +5261,7 @@ that Calc formulas can operate on them. **** Modified link escaping - David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]: + David Maus worked on `org-link-escape'. See [[https://orgmode.org/list/87k4gysacq.wl%dmaus@ictsoc.de][his message]]: : Percent escaping is used in Org mode to escape certain characters : in links that would either break the parser (e.g. square brackets @@ -5151,7 +5700,7 @@ that Calc formulas can operate on them. Thanks to Nicolas Goaziou for coding these changes. -**** A property value of "nil" now means to unset a property +**** A property value of =nil= now means to unset a property This can be useful in particular with property inheritance, if some upper level has the property, and some grandchild of it diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index a261cb5a5fb..b890fe2ca83 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.3} +\def\orgversionnumber{9.4.1} \def\versionyear{2019} % latest update \input emacsver.tex @@ -17,7 +17,7 @@ \pdflayout=(0l) % Nothing else needs to be changed below this line. -% Copyright (C) 1987, 1993, 1996--1997, 2001--2020 Free Software +% Copyright (C) 1987, 1993, 1996-1997, 2001-2020 Free Software % Foundation, Inc. % This document is free software: you can redistribute it and/or modify @@ -79,6 +79,9 @@ \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 https://www.gnu.org/software/emacs}} + \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -515,7 +518,7 @@ after ``{\tt :}'', and dictionary words elsewhere. \key{special commands in property lines}{C-c C-c} \key{next/previous allowed value}{S-LEFT/RIGHT} \key{turn on column view}{C-c C-x C-c} -\key{capture columns view in dynamic block}{C-c C-x i} +\key{capture columns view in dynamic block}{C-c C-x x} \key{quit column view}{q} \key{show full value}{v} @@ -558,7 +561,7 @@ after ``{\tt :}'', and dictionary words elsewhere. \key{stop/cancel clock on current item}{C-c C-x C-o/x} \key{display total subtree times}{C-c C-x C-d} \key{remove displayed times}{C-c C-c} -\key{insert/update table with clock report}{C-c C-x C-r} +\key{insert/update table with clock report}{C-c C-x C-x} \section{Agenda Views} diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 3a26bc014b2..c5155fbfcc8 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -182,7 +182,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." cmdline))) ""))) (when results - (setq results (org-trim (org-remove-indentation results))) + (setq results (org-remove-indentation results)) (org-babel-reassemble-table (org-babel-result-cond (cdr (assq :result-params params)) (org-babel-read results t) @@ -232,7 +232,13 @@ its header arguments." (list ;; includes (mapconcat - (lambda (inc) (format "#include %s" inc)) + (lambda (inc) + ;; :includes '( ) gives us a list of + ;; symbols; convert those to strings. + (when (symbolp inc) (setq inc (symbol-name inc))) + (if (string-prefix-p "<" inc) + (format "#include %s" inc) + (format "#include \"%s\"" inc))) includes "\n") ;; defines (mapconcat diff --git a/lisp/org/ob-J.el b/lisp/org/ob-J.el index c0145211bd3..e66227b8df6 100644 --- a/lisp/org/ob-J.el +++ b/lisp/org/ob-J.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2011-2020 Free Software Foundation, Inc. ;; Author: Oleh Krehel +;; Maintainer: Joseph Novakovich ;; Keywords: literate programming, reproducible research ;; Homepage: https://orgmode.org @@ -76,6 +77,8 @@ 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))) + (sit-time (let ((sit (assq :sit params))) + (if sit (cdr sit) .1))) (full-body (org-babel-expand-body:J body params processed-params)) (tmp-script-file (org-babel-temp-file "J-src"))) @@ -86,9 +89,9 @@ This function is called by `org-babel-execute-src-block'." (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))))) + (org-babel-J-eval-string full-body sit-time))))) -(defun org-babel-J-eval-string (str) +(defun org-babel-J-eval-string (str sit-time) "Sends STR to the `j-console-cmd' session and executes it." (let ((session (j-console-ensure-session))) (with-current-buffer (process-buffer session) @@ -96,7 +99,7 @@ This function is called by `org-babel-execute-src-block'." (insert (format "\n%s\n" str)) (let ((beg (point))) (comint-send-input) - (sit-for .1) + (sit-for sit-time) (buffer-substring-no-properties beg (point-max)))))) diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index b52c7591ad2..5e9d35f58e2 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -193,7 +193,8 @@ This function is called by `org-babel-execute-src-block'." (org-babel-comint-in-buffer session (mapc (lambda (var) (end-of-line 1) (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session)) var-lines)) + (org-babel-comint-wait-for-output session)) + var-lines)) session)) (defun org-babel-load-session:R (session body params) @@ -459,11 +460,11 @@ last statement in BODY, as elisp." "R-specific processing of return value. Insert hline if column names in output have been requested." (if column-names-p - (cons (car result) (cons 'hline (cdr result))) + (condition-case nil + (cons (car result) (cons 'hline (cdr result))) + (error "Could not parse R result")) result)) (provide 'ob-R) - - ;;; ob-R.el ends here diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el index d473118639a..4c9e83525d9 100644 --- a/lisp/org/ob-abc.el +++ b/lisp/org/ob-abc.el @@ -4,8 +4,7 @@ ;; Author: William Waites ;; Keywords: literate programming, music -;; Homepage: http://www.tardis.ed.ac.uk/wwaites -;; Version: 0.01 +;; Homepage: https://www.tardis.ed.ac.uk/~wwaites ;; This file is part of GNU Emacs. @@ -87,4 +86,5 @@ (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 bdc74b84920..da7f870d494 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -134,6 +134,4 @@ Otherwise, it is either `real', if some elements are floats, or (provide 'ob-asymptote) - - ;;; ob-asymptote.el ends here diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index 74bbc4c2be1..577878349c5 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -106,6 +106,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-awk) - - ;;; ob-awk.el ends here diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index 85bcf1d4132..c2937f6952b 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -105,6 +105,4 @@ (provide 'ob-calc) - - ;;; ob-calc.el ends here diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index 0d6d1c0a84a..299a326e429 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -30,80 +30,70 @@ ;; - clojure (at least 1.2.0) ;; - clojure-mode -;; - either cider or SLIME +;; - inf-clojure, cider or SLIME -;; For Cider, see https://github.com/clojure-emacs/cider +;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode +;; For cider, see https://github.com/clojure-emacs/cider +;; For inf-clojure, 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) -(require 'org-macs) -(declare-function cider-jack-in "ext:cider" (&optional prompt-project cljs-too)) (declare-function cider-current-connection "ext:cider-client" (&optional type)) (declare-function cider-current-ns "ext:cider-client" ()) -(declare-function cider-repls "ext:cider-connection" (&optional type ensure)) -(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2)) +(declare-function inf-clojure "ext:inf-clojure" (cmd)) +(declare-function inf-clojure-cmd "ext:inf-clojure" (project-type)) +(declare-function inf-clojure-eval-string "ext:inf-clojure" (code)) +(declare-function inf-clojure-project-type "ext:inf-clojure" ()) (declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) -(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value)) -(declare-function nrepl-request:eval "ext:nrepl-client" (input callback connection &optional ns line column additional-params tooling)) (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling)) +(declare-function sesman-start-session "ext:sesman" (system)) (declare-function slime-eval "ext:slime" (sexp &optional package)) -(defvar nrepl-sync-request-timeout) (defvar cider-buffer-ns) -(defvar sesman-system) -(defvar cider-version) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) +(add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs")) (defvar org-babel-default-header-args:clojure '()) -(defvar org-babel-header-args:clojure '((ns . :any) - (package . :any))) +(defvar org-babel-header-args:clojure '((ns . :any) (package . :any))) +(defvar org-babel-default-header-args:clojurescript '()) +(defvar org-babel-header-args:clojurescript '((package . :any))) -(defcustom org-babel-clojure-sync-nrepl-timeout 10 - "Timeout value, in seconds, of a Clojure sync call. -If the value is nil, timeout is disabled." - :group 'org-babel - :type 'integer - :version "26.1" - :package-version '(Org . "9.1") - :safe #'wholenump) - -(defcustom org-babel-clojure-backend - (cond ((featurep 'cider) 'cider) - (t 'slime)) +(defcustom org-babel-clojure-backend nil "Backend used to evaluate Clojure code blocks." :group 'org-babel :type '(choice + (const :tag "inf-clojure" inf-clojure) (const :tag "cider" cider) - (const :tag "SLIME" slime))) + (const :tag "slime" slime) + (const :tag "Not configured yet" nil))) (defcustom org-babel-clojure-default-ns "user" "Default Clojure namespace for source block when finding ns failed." :type 'string :group 'org-babel) -(defun org-babel-clojure-cider-current-ns () - "Like `cider-current-ns' except `cider-find-ns'." - (or cider-buffer-ns - (let ((repl-buf (cider-current-connection))) - (and repl-buf (buffer-local-value 'cider-buffer-ns repl-buf))) - org-babel-clojure-default-ns)) - (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." (let* ((vars (org-babel--get-vars params)) (ns (or (cdr (assq :ns params)) - (org-babel-clojure-cider-current-ns))) + (if (eq org-babel-clojure-backend 'cider) + (or cider-buffer-ns + (let ((repl-buf (cider-current-connection))) + (and repl-buf (buffer-local-value + 'cider-buffer-ns repl-buf)))) + org-babel-clojure-default-ns))) (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) + ;; Remove comments, they break (let [...] ...) bindings + (body (replace-regexp-in-string "^[ ]*;+.*$" "" body)) (body (org-trim (concat ;; Source block specified namespace :ns. @@ -113,7 +103,7 @@ If the value is nil, timeout is disabled." (format "(let [%s]\n%s)" (mapconcat (lambda (var) - (format "%S (quote %S)" (car var) (cdr var))) + (format "%S %S" (car var) (cdr var))) vars "\n ") body)))))) @@ -122,161 +112,141 @@ If the value is nil, timeout is disabled." (format "(clojure.pprint/pprint (do %s))" body) body))) -(defun org-babel-execute:clojure (body params) - "Execute a block of Clojure code with Babel. -The underlying process performed by the code block can be output -using the :show-process parameter." - (let* ((expanded (org-babel-expand-body:clojure body params)) - (response (list 'dict)) - result) - (cl-case org-babel-clojure-backend - (cider - (require 'cider) - (let ((result-params (cdr (assq :result-params params))) - (show (cdr (assq :show-process params)))) - (if (member show '(nil "no")) - ;; Run code without showing the process. - (progn - (setq response - (let ((nrepl-sync-request-timeout - org-babel-clojure-sync-nrepl-timeout)) - (nrepl-sync-request:eval expanded - (cider-current-connection)))) - (setq result - (concat - (nrepl-dict-get response - (if (or (member "output" result-params) - (member "pp" result-params)) - "out" - "value")) - (nrepl-dict-get response "ex") - (nrepl-dict-get response "root-ex") - (nrepl-dict-get response "err")))) - ;; Show the process in an output buffer/window. - (let ((process-buffer (switch-to-buffer-other-window - "*Clojure Show Process Sub Buffer*")) - status) - ;; Run the Clojure code in nREPL. - (nrepl-request:eval - expanded - (lambda (resp) - (when (member "out" resp) - ;; Print the output of the nREPL in the output buffer. - (princ (nrepl-dict-get resp "out") process-buffer)) - (when (member "ex" resp) - ;; In case there is an exception, then add it to the - ;; output buffer as well. - (princ (nrepl-dict-get resp "ex") process-buffer) - (princ (nrepl-dict-get resp "root-ex") process-buffer)) - (when (member "err" resp) - ;; In case there is an error, then add it to the - ;; output buffer as well. - (princ (nrepl-dict-get resp "err") process-buffer)) - (nrepl--merge response resp) - ;; Update the status of the nREPL output session. - (setq status (nrepl-dict-get response "status"))) - (cider-current-connection)) +(defvar ob-clojure-inf-clojure-filter-out) +(defvar ob-clojure-inf-clojure-tmp-output) +(defun ob-clojure-inf-clojure-output (s) + "Store a trimmed version of S in a variable and return S." + (let ((s0 (org-trim + (replace-regexp-in-string + ob-clojure-inf-clojure-filter-out "" s)))) + (push s0 ob-clojure-inf-clojure-tmp-output)) + s) - ;; Wait until the nREPL code finished to be processed. - (while (not (member "done" status)) - (nrepl-dict-put response "status" (remove "need-input" status)) - (accept-process-output nil 0.01) - (redisplay)) +(defmacro ob-clojure-with-temp-expanded (expanded params &rest body) + "Run BODY on EXPANDED code block with PARAMS." + (declare (debug (body)) (indent 2)) + `(with-temp-buffer + (insert ,expanded) + (goto-char (point-min)) + (while (not (looking-at "\\s-*\\'")) + (let* ((beg (point)) + (end (progn (forward-sexp) (point))) + (exp (org-babel-expand-body:clojure + (buffer-substring beg end) ,params))) + (sit-for .1) + ,@body)))) - ;; Delete the show buffer & window when the processing is - ;; finalized. - (mapc #'delete-window - (get-buffer-window-list process-buffer nil t)) - (kill-buffer process-buffer) +(defsubst ob-clojure-string-or-list (l) + "Convert list L into a string or a list of list." + (if (and (listp l) (= (length l) 1)) + (car l) + (mapcar #'list l))) - ;; Put the output or the value in the result section of - ;; the code block. - (setq result - (concat - (nrepl-dict-get response - (if (or (member "output" result-params) - (member "pp" result-params)) - "out" - "value")) +(defvar inf-clojure-buffer) +(defvar comint-prompt-regexp) +(defvar inf-clojure-comint-prompt-regexp) +(defun ob-clojure-eval-with-inf-clojure (expanded params) + "Evaluate EXPANDED code block with PARAMS using inf-clojure." + (condition-case nil (require 'inf-clojure) + (user-error "inf-clojure not available")) + ;; Maybe initiate the inf-clojure session + (unless (and inf-clojure-buffer + (buffer-live-p (get-buffer inf-clojure-buffer))) + (save-window-excursion + (let* ((alias (cdr (assq :alias params))) + (cmd0 (inf-clojure-cmd (inf-clojure-project-type))) + (cmd (if alias (replace-regexp-in-string + "clojure" (format "clojure -A%s" alias) + cmd0) + cmd0))) + (setq comint-prompt-regexp inf-clojure-comint-prompt-regexp) + (funcall-interactively #'inf-clojure cmd) + (goto-char (point-max)))) + (sit-for 1)) + ;; Now evaluate the code + (setq ob-clojure-inf-clojure-filter-out + (concat "^nil\\|nil$\\|\\s-*" + (or (cdr (assq :ns params)) + org-babel-clojure-default-ns) + "=>\\s-*")) + (add-hook 'comint-preoutput-filter-functions + #'ob-clojure-inf-clojure-output) + (setq ob-clojure-inf-clojure-tmp-output nil) + (ob-clojure-with-temp-expanded expanded nil + (inf-clojure-eval-string exp)) + (sit-for .5) + (remove-hook 'comint-preoutput-filter-functions + #'ob-clojure-inf-clojure-output) + ;; And return the result + (ob-clojure-string-or-list + (delete nil + (mapcar + (lambda (s) + (unless (or (equal "" s) + (string-match-p "^Clojure" s)) + s)) + (reverse ob-clojure-inf-clojure-tmp-output))))) + +(defun ob-clojure-eval-with-cider (expanded params) + "Evaluate EXPANDED code block with PARAMS using cider." + (condition-case nil (require 'cider) + (user-error "cider not available")) + (let ((connection (cider-current-connection (cdr (assq :target params)))) + (result-params (cdr (assq :result-params params))) + result0) + (unless connection (sesman-start-session 'CIDER)) + (if (not connection) + ;; Display in the result instead of using `user-error' + (setq result0 "Please reevaluate when nREPL is connected") + (ob-clojure-with-temp-expanded expanded params + (let ((response (nrepl-sync-request:eval exp connection))) + (push (or (nrepl-dict-get response "root-ex") (nrepl-dict-get response "ex") - (nrepl-dict-get response "root-ex") - (nrepl-dict-get response "err"))))))) - (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)) + (nrepl-dict-get + response (if (or (member "output" result-params) + (member "pp" result-params)) + "out" + "value"))) + result0))) + (ob-clojure-string-or-list + (reverse (delete "" (mapcar (lambda (r) + (replace-regexp-in-string "nil" "" r)) + result0))))))) + +(defun ob-clojure-eval-with-slime (expanded params) + "Evaluate EXPANDED code block with PARAMS using slime." + (condition-case nil (require 'slime) + (user-error "slime not available")) + (with-temp-buffer + (insert expanded) + (slime-eval + `(swank:eval-and-grab-output + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assq :package params))))) + +(defun org-babel-execute:clojure (body params) + "Execute a block of Clojure code with Babel." + (unless org-babel-clojure-backend + (user-error "You need to customize org-babel-clojure-backend")) + (let* ((expanded (org-babel-expand-body:clojure body params)) + (result-params (cdr (assq :result-params params))) + result) + (setq result + (cond + ((eq org-babel-clojure-backend 'inf-clojure) + (ob-clojure-eval-with-inf-clojure expanded params)) + ((eq org-babel-clojure-backend 'cider) + (ob-clojure-eval-with-cider expanded params)) + ((eq org-babel-clojure-backend 'slime) + (ob-clojure-eval-with-slime expanded params)))) + (org-babel-result-cond result-params result (condition-case nil (org-babel-script-escape result) (error result))))) -(defun org-babel-clojure-initiate-session (&optional session _params) - "Initiate a session named SESSION according to PARAMS." - (when (and session (not (string= session "none"))) - (save-window-excursion - (cond - ((org-babel-comint-buffer-livep session) nil) - ;; CIDER jack-in to the Clojure project directory. - ((eq org-babel-clojure-backend 'cider) - (require 'cider) - (let ((session-buffer - (save-window-excursion - (if (version< cider-version "0.18.0") - ;; Older CIDER (without sesman) still need to use - ;; old way. - (cider-jack-in nil) ;jack-in without project - ;; New CIDER (with sesman to manage sessions). - (unless (cider-repls) - (let ((sesman-system 'CIDER)) - (call-interactively 'sesman-link-with-directory)))) - (current-buffer)))) - (when (org-babel-comint-buffer-livep session-buffer) - (sit-for .25) - session-buffer))) - ((eq org-babel-clojure-backend 'slime) - (error "Session evaluation with SLIME is not supported")) - (t - (error "Session initiate failed"))) - (get-buffer session)))) - -(defun org-babel-prep-session:clojure (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let ((session (org-babel-clojure-initiate-session session)) - (var-lines (org-babel-variable-assignments:clojure params))) - (when session - (org-babel-comint-in-buffer session - (dolist (var var-lines) - (insert var) - (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) - (goto-char (point-max))))) - session)) - -(defun org-babel-clojure-var-to-clojure (var) - "Convert src block's VAR to Clojure variable." - (cond - ((listp var) - (replace-regexp-in-string "(" "'(" var)) - ((stringp var) - ;; Wrap Babel passed-in header argument value with quotes in Clojure. - (format "\"%s\"" var)) - (t - (format "%S" var)))) - -(defun org-babel-variable-assignments:clojure (params) - "Return a list of Clojure statements assigning the block's variables in PARAMS." - (mapcar - (lambda (pair) - (format "(def %s %s)" - (car pair) - (org-babel-clojure-var-to-clojure (cdr pair)))) - (org-babel--get-vars params))) +(defun org-babel-execute:clojurescript (body params) + "Evaluate BODY with PARAMS as ClojureScript code." + (org-babel-execute:clojure body (cons '(:target . "cljs") params))) (provide 'ob-clojure) diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 552b7a037cf..d3484bb7c60 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -151,6 +151,4 @@ FILE exists at end of evaluation." (provide 'ob-comint) - - ;;; ob-comint.el ends here diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el index 56a57cdf649..e473eac3301 100644 --- a/lisp/org/ob-coq.el +++ b/lisp/org/ob-coq.el @@ -27,7 +27,7 @@ ;; session evaluation is supported. Requires both coq.el and ;; coq-inferior.el, both of which are distributed with Coq. ;; -;; http://coq.inria.fr/ +;; https://coq.inria.fr/ ;;; Code: (require 'ob) @@ -76,3 +76,5 @@ create one. Return the initialized session." (get-buffer org-babel-coq-buffer)) (provide 'ob-coq) + +;;; ob-coq.el ends here diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 7654c7ebe41..7300f239eef 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -38,6 +38,7 @@ (defvar org-link-file-path-type) (defvar org-src-lang-modes) (defvar org-src-preserve-indentation) +(defvar org-babel-tangle-uncomment-comments) (declare-function org-at-item-p "org-list" ()) (declare-function org-at-table-p "org" (&optional table-type)) @@ -59,6 +60,7 @@ (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-forward-heading-same-level "org" (arg &optional invisible-ok)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-indent-line "org" ()) (declare-function org-list-get-list-end "org-list" (item struct prevs)) @@ -67,7 +69,6 @@ (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 org-narrow-to-subtree "org" ()) (declare-function org-next-block "org" (arg &optional backward block-regexp)) @@ -78,6 +79,7 @@ (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-get-lang-mode "org-src" (lang)) (declare-function org-table-align "org-table" ()) +(declare-function org-table-convert-region "org-table" (beg0 end0 &optional separator)) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function org-table-import "org-table" (file arg)) (declare-function org-table-to-lisp "org-table" (&optional txt)) @@ -164,7 +166,6 @@ This string must include a \"%s\" which will be replaced by the results." "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) @@ -238,7 +239,8 @@ should be asked whether to allow evaluation." (if (functionp org-confirm-babel-evaluate) (funcall org-confirm-babel-evaluate ;; Language, code block body. - (nth 0 info) (nth 1 info)) + (nth 0 info) + (org-babel--expand-body info)) org-confirm-babel-evaluate)))) (cond (noeval nil) @@ -400,6 +402,7 @@ then run `org-babel-switch-to-session'." (file . :any) (file-desc . :any) (file-ext . :any) + (file-mode . ((#o755 #o555 #o444 :any))) (hlines . ((no yes))) (mkdirp . ((yes no))) (no-expand) @@ -487,11 +490,21 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'." "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\\}\\)>") + (rx (seq bol + (zero-or-more (any "\t ")) + "#+results" + (opt "[" + ;; Time stamp part. + (opt "(" + (= 4 digit) (= 2 "-" (= 2 digit)) + " " + (= 2 digit) (= 2 ":" (= 2 digit)) + ") ") + ;; SHA1 hash. + (group (one-or-more hex-digit)) + "]") + ":" + (zero-or-more (any "\t ")))) "Regular expression used to match result lines. If the results are associated with a hash key then the hash will be saved in match group 1.") @@ -622,6 +635,17 @@ a list with the following pattern: (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info))) info)))) +(defun org-babel--expand-body (info) + "Expand noweb references in body and remove any coderefs." + (let ((coderef (nth 6 info)) + (expand + (if (org-babel-noweb-p (nth 2 info) :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)))) + ;;;###autoload (defun org-babel-execute-src-block (&optional arg info params) "Execute the current source code block. @@ -667,17 +691,7 @@ block." ((org-babel-confirm-evaluate info) (let* ((lang (nth 0 info)) (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)))) + (body (org-babel--expand-body info)) (dir (cdr (assq :dir params))) (mkdirp (cdr (assq :mkdirp params))) (default-directory @@ -721,7 +735,11 @@ block." (with-temp-file file (insert (org-babel-format-result result - (cdr (assq :sep params)))))) + (cdr (assq :sep params))))) + ;; Set file permissions if header argument + ;; `:file-mode' is provided. + (when (assq :file-mode params) + (set-file-modes file (cdr (assq :file-mode params))))) (setq result file)) ;; Possibly perform post process provided its ;; appropriate. Dynamically bind "*this*" to the @@ -1301,10 +1319,9 @@ CONTEXT specifies the context of evaluation. It can be `:eval', "Return the current in-buffer hash." (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))))) + (org-with-point-at result + (let ((case-fold-search t)) (looking-at org-babel-result-regexp)) + (match-string-no-properties 1))))) (defun org-babel-hide-hash () "Hide the hash in the current results line. @@ -1312,7 +1329,8 @@ Only the initial `org-babel-hash-show' characters of the hash 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) + (when (and (let ((case-fold-search t)) + (re-search-forward org-babel-result-regexp nil t)) (match-string 1)) (let* ((start (match-beginning 1)) (hide-start (+ org-babel-hash-show start)) @@ -1330,11 +1348,12 @@ Only the initial `org-babel-hash-show' characters of each hash will remain visible. This function should be called as part of the `org-mode-hook'." (save-excursion - (while (and (not org-babel-hash-show-time) - (re-search-forward org-babel-result-regexp nil t)) - (goto-char (match-beginning 0)) - (org-babel-hide-hash) - (goto-char (match-end 0))))) + (let ((case-fold-search t)) + (while (and (not org-babel-hash-show-time) + (re-search-forward org-babel-result-regexp nil t)) + (goto-char (match-beginning 0)) + (org-babel-hide-hash) + (goto-char (match-end 0)))))) (add-hook 'org-mode-hook 'org-babel-hide-all-hashes) (defun org-babel-hash-at-point (&optional point) @@ -1363,9 +1382,10 @@ portions of results lines." (interactive) (org-babel-show-result-all) (save-excursion - (while (re-search-forward org-babel-result-regexp nil t) - (save-excursion (goto-char (match-beginning 0)) - (org-babel-hide-result-toggle-maybe))))) + (let ((case-fold-search t)) + (while (re-search-forward org-babel-result-regexp nil t) + (save-excursion (goto-char (match-beginning 0)) + (org-babel-hide-result-toggle-maybe)))))) (defun org-babel-show-result-all () "Unfold all results in the current buffer." @@ -1377,52 +1397,50 @@ portions of results lines." "Toggle visibility of result at point." (interactive) (let ((case-fold-search t)) - (if (save-excursion - (beginning-of-line 1) - (looking-at org-babel-result-regexp)) - (progn (org-babel-hide-result-toggle) - t) ;; to signal that we took action - nil))) ;; to signal that we did not + (and (org-match-line org-babel-result-regexp) + (progn (org-babel-hide-result-toggle) t)))) (defun org-babel-hide-result-toggle (&optional force) "Toggle the visibility of the current result." (interactive) (save-excursion (beginning-of-line) - (if (re-search-forward org-babel-result-regexp nil t) - (let ((start (progn (beginning-of-line 2) (- (point) 1))) - (end (progn - (while (looking-at org-babel-multi-line-header-regexp) - (forward-line 1)) - (goto-char (- (org-babel-result-end) 1)) (point))) - ov) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-babel-hide-result)) - (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 - (overlay-put - ov 'isearch-open-invisible - (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)))) - (push ov org-babel-hide-result-overlays))) - (error "Not looking at a result line")))) + (let ((case-fold-search t)) + (unless (re-search-forward org-babel-result-regexp nil t) + (error "Not looking at a result line"))) + (let ((start (progn (beginning-of-line 2) (1- (point)))) + (end (progn + (while (looking-at org-babel-multi-line-header-regexp) + (forward-line 1)) + (goto-char (1- (org-babel-result-end))) + (point))) + ov) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-babel-hide-result)) + (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 + (overlay-put + ov 'isearch-open-invisible + (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)))) + (push ov org-babel-hide-result-overlays))))) ;; org-tab-after-check-for-cycling-hook (add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) @@ -1654,7 +1672,8 @@ Note: this function removes any hlines in TABLE." (mapcar (lambda (row) (if (listp row) (cons (or (pop rownames) "") row) - row)) table) + row)) + table) table)) (defun org-babel-pick-name (names selector) @@ -1879,9 +1898,9 @@ region is not active then the point is demarcated." (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 + (upper-case-p (and block (let (case-fold-search) - (string-match-p "#\\+begin_src" block))))) + (string-match-p "#\\+BEGIN_SRC" block))))) (if info (mapc (lambda (place) @@ -1895,9 +1914,9 @@ region is not active then the point is demarcated." (delete-region (point-at-bol) (point-at-eol))) (insert (concat (if (looking-at "^") "" "\n") - indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n") + indent (if upper-case-p "#+END_SRC\n" "#+end_src\n") (if arg stars indent) "\n" - indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") + indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ") lang (if (> (length headers) 1) (concat " " headers) headers) @@ -1918,14 +1937,16 @@ 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") "") - (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") - lang "\n" - body + (if upper-case-p "#+BEGIN_SRC " "#+begin_src ") + lang "\n" body (if (or (= (length body) 0) (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))))) + (string-suffix-p "\n" body)) + "" + "\n") + (if upper-case-p "#+END_SRC\n" "#+end_src\n"))) + (goto-char start) + (move-end-of-line 1))))) (defun org-babel--insert-results-keyword (name hash) "Insert RESULTS keyword with NAME value at point. @@ -1938,7 +1959,7 @@ the results hash, or nil. Leave point before the keyword." (cond ((not hash) nil) (org-babel-hash-show-time (format "[%s %s]" - (format-time-string "<%F %T>") + (format-time-string "(%F %T)") hash)) (t (format "[%s]" hash))) ":" @@ -1964,7 +1985,7 @@ 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) + (let ((case-fold-search t)) (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)))) @@ -2371,13 +2392,58 @@ INFO may provide the values of these header arguments (in the (org-babel-chomp result "\n")))) (t (goto-char beg) (insert result))) (setq end (copy-marker (point) t)) - ;; possibly wrap result + ;; 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 (split-string name))) - nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) + (let* ((full (or (cdr (assq :wrap (nth 2 info))) "results")) + (split (split-string full)) + (type (car split)) + (opening-line (concat "#+begin_" full)) + (closing-line (concat "#+end_" type))) + (cond + ;; Escape contents from "export" wrap. Wrap + ;; inline results within an export snippet with + ;; appropriate value. + ((eq t (compare-strings type nil nil "export" nil nil t)) + (let ((backend (pcase split + (`(,_) "none") + (`(,_ ,b . ,_) b)))) + (funcall wrap + opening-line closing-line + nil nil + (format "{{{results(@@%s:" + backend) "@@)}}}"))) + ;; Escape contents from "example" wrap. Mark + ;; inline results as verbatim. + ((eq t (compare-strings type nil nil "example" nil nil t)) + (funcall wrap + opening-line closing-line + nil nil + "{{{results(=" "=)}}}")) + ;; Escape contents from "src" wrap. Mark + ;; inline results as inline source code. + ((eq t (compare-strings type nil nil "src" nil nil t)) + (let ((inline-open + (pcase split + (`(,_) + "{{{results(src_none{") + (`(,_ ,language) + (format "{{{results(src_%s{" language)) + (`(,_ ,language . ,rest) + (let ((r (mapconcat #'identity rest " "))) + (format "{{{results(src_%s[%s]{" + language r)))))) + (funcall wrap + opening-line closing-line + nil nil + inline-open "})}}}"))) + ;; Do not escape contents in non-verbatim + ;; blocks. Return plain inline results. + (t + (funcall wrap + opening-line closing-line + t nil + "{{{results(" ")}}}"))))) ((member "html" result-params) (funcall wrap "#+begin_export html" "#+end_export" nil nil "{{{results(@@html:" "@@)}}}")) @@ -2433,11 +2499,12 @@ INFO may provide the values of these header arguments (in the (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))) + (let ((location (org-babel-where-is-src-block-result nil info)) + (case-fold-search t)) (when location (save-excursion (goto-char location) - (when (looking-at (concat org-babel-result-regexp ".*$")) + (when (looking-at org-babel-result-regexp) (delete-region (if keep-keyword (line-beginning-position 2) (save-excursion @@ -2488,7 +2555,7 @@ in the buffer." (if (memq (org-element-type element) ;; Possible results types. '(drawer example-block export-block fixed-width item - plain-list src-block table)) + plain-list special-block src-block table)) (save-excursion (goto-char (min (point-max) ;for narrowed buffers (org-element-property :end element))) @@ -2502,16 +2569,19 @@ If the `default-directory' is different from the containing file's directory then expand relative links." (when (stringp result) (let ((same-directory? - (and buffer-file-name + (and (buffer-file-name (buffer-base-buffer)) (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))))) + (expand-file-name + (file-name-directory + (buffer-file-name (buffer-base-buffer))))))))) (format "[[file:%s]%s]" - (if (and default-directory buffer-file-name same-directory?) + (if (and default-directory + (buffer-file-name (buffer-base-buffer)) same-directory?) (if (eq org-link-file-path-type 'adaptive) (file-relative-name (expand-file-name result default-directory) - (file-name-directory (buffer-file-name))) + (file-name-directory + (buffer-file-name (buffer-base-buffer)))) (expand-file-name result default-directory)) result) (if description (concat "[" description "]") ""))))) @@ -2707,117 +2777,110 @@ would set the value of argument \"a\" equal to \"9\". Note that these arguments are not evaluated in the current source-code block but are passed literally to the \"example-block\"." (let* ((parent-buffer (or parent-buffer (current-buffer))) - (info (or info (org-babel-get-src-block-info 'light))) + (info (or info (org-babel-get-src-block-info 'light))) (lang (nth 0 info)) (body (nth 1 info)) - (ob-nww-start org-babel-noweb-wrap-start) - (ob-nww-end org-babel-noweb-wrap-end) - (new-body "") - (nb-add (lambda (text) (setq new-body (concat new-body text)))) - index source-name evaluate prefix) - (with-temp-buffer - (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)) - (save-match-data (setf source-name (match-string 1))) - (save-match-data (setq evaluate (string-match "(.*)" source-name))) - (save-match-data - (setq prefix - (buffer-substring (match-beginning 0) - (save-excursion - (beginning-of-line 1) (point))))) - ;; add interval to new-body (removing noweb reference) - (goto-char (match-beginning 0)) - (funcall nb-add (buffer-substring index (point))) - (goto-char (match-end 0)) - (setq index (point)) - (funcall - nb-add - (with-current-buffer parent-buffer - (save-restriction - (widen) - (mapconcat ;; Interpose PREFIX between every line. - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (or - ;; Retrieve from the Library of Babel. - (nth 2 (assoc-string source-name org-babel-library-of-babel)) - ;; Return the contents of headlines literally. - (save-excursion - (when (org-babel-ref-goto-headline-id source-name) - (org-babel-ref-headline-body))) - ;; Find the expansion of reference in this buffer. - (save-excursion - (goto-char (point-min)) - (let* ((name-regexp - (org-babel-named-src-block-regexp-for-name - source-name)) - (comment - (string= "noweb" - (cdr (assq :comments (nth 2 info))))) - (c-wrap - (lambda (s) - ;; Comment, according to LANG mode, - ;; string S. Return new string. - (with-temp-buffer - (funcall (org-src-get-lang-mode lang)) - (comment-region (point) - (progn (insert s) (point))) - (org-trim (buffer-string))))) - (expand-body - (lambda (i) - ;; Expand body of code blocked - ;; represented by block info I. - (let ((b (if (org-babel-noweb-p (nth 2 i) :eval) - (org-babel-expand-noweb-references i) - (nth 1 i)))) - (if (not comment) b - (let ((cs (org-babel-tangle-comment-links i))) - (concat (funcall c-wrap (car cs)) "\n" - b "\n" - (funcall c-wrap (cadr cs))))))))) - (if (and (re-search-forward name-regexp nil t) - (not (org-in-commented-heading-p))) - ;; Found a source block named SOURCE-NAME. - ;; Assume it is unique; do not look after - ;; `:noweb-ref' header argument. - (funcall expand-body - (org-babel-get-src-block-info 'light)) - ;; Though luck. We go into the long process - ;; of checking each source block and expand - ;; those with a matching Noweb reference. - (let ((expansion nil)) - (org-babel-map-src-blocks nil - (unless (org-in-commented-heading-p) - (let* ((info - (org-babel-get-src-block-info 'light)) - (parameters (nth 2 info))) - (when (equal source-name - (cdr (assq :noweb-ref parameters))) - (push (funcall expand-body info) expansion) - (push (or (cdr (assq :noweb-sep parameters)) - "\n") - expansion))))) - (when expansion - (mapconcat #'identity - (nreverse (cdr expansion)) - "")))))) - ;; Possibly raise an error if named block doesn't exist. - (if (or org-babel-noweb-error-all-langs - (member lang org-babel-noweb-error-langs)) - (error "%s could not be resolved (see \ -`org-babel-noweb-error-langs')" - (org-babel-noweb-wrap source-name)) - ""))) - "[\n\r]") - (concat "\n" prefix)))))) - (funcall nb-add (buffer-substring index (point-max)))) - new-body)) + (comment (string= "noweb" (cdr (assq :comments (nth 2 info))))) + (noweb-re (format "\\(.*?\\)\\(%s\\)" + (with-current-buffer parent-buffer + (org-babel-noweb-wrap)))) + (cache nil) + (c-wrap + (lambda (s) + ;; Comment string S, according to LANG mode. Return new + ;; string. + (unless org-babel-tangle-uncomment-comments + (with-temp-buffer + (funcall (org-src-get-lang-mode lang)) + (comment-region (point) + (progn (insert s) (point))) + (org-trim (buffer-string)))))) + (expand-body + (lambda (i) + ;; Expand body of code represented by block info I. + (let ((b (if (org-babel-noweb-p (nth 2 i) :eval) + (org-babel-expand-noweb-references i) + (nth 1 i)))) + (if (not comment) b + (let ((cs (org-babel-tangle-comment-links i))) + (concat (funcall c-wrap (car cs)) "\n" + b "\n" + (funcall c-wrap (cadr cs)))))))) + (expand-references + (lambda (ref cache) + (pcase (gethash ref cache) + (`(,last . ,previous) + ;; Ignore separator for last block. + (let ((strings (list (funcall expand-body last)))) + (dolist (i previous) + (let ((parameters (nth 2 i))) + ;; Since we're operating in reverse order, first + ;; push separator, then body. + (push (or (cdr (assq :noweb-sep parameters)) "\n") + strings) + (push (funcall expand-body i) strings))) + (mapconcat #'identity strings ""))) + ;; Raise an error about missing reference, or return the + ;; empty string. + ((guard (or org-babel-noweb-error-all-langs + (member lang org-babel-noweb-error-langs))) + (error "Cannot resolve %s (see `org-babel-noweb-error-langs')" + (org-babel-noweb-wrap ref))) + (_ ""))))) + (replace-regexp-in-string + noweb-re + (lambda (m) + (with-current-buffer parent-buffer + (save-match-data + (let* ((prefix (match-string 1 m)) + (id (match-string 3 m)) + (evaluate (string-match-p "(.*)" id)) + (expansion + (cond + (evaluate + ;; Evaluation can potentially modify the buffer + ;; and invalidate the cache: reset it. + (setq cache nil) + (let ((raw (org-babel-ref-resolve id))) + (if (stringp raw) raw (format "%S" raw)))) + ;; Retrieve from the Library of Babel. + ((nth 2 (assoc-string id org-babel-library-of-babel))) + ;; Return the contents of headlines literally. + ((org-babel-ref-goto-headline-id id) + (org-babel-ref-headline-body)) + ;; Look for a source block named SOURCE-NAME. If + ;; found, assume it is unique; do not look after + ;; `:noweb-ref' header argument. + ((org-with-point-at 1 + (let ((r (org-babel-named-src-block-regexp-for-name id))) + (and (re-search-forward r nil t) + (not (org-in-commented-heading-p)) + (funcall expand-body + (org-babel-get-src-block-info t)))))) + ;; All Noweb references were cached in a previous + ;; run. Extract the information from the cache. + ((hash-table-p cache) + (funcall expand-references id cache)) + ;; Though luck. We go into the long process of + ;; checking each source block and expand those + ;; with a matching Noweb reference. Since we're + ;; going to visit all source blocks in the + ;; document, cache information about them as well. + (t + (setq cache (make-hash-table :test #'equal)) + (org-with-wide-buffer + (org-babel-map-src-blocks nil + (if (org-in-commented-heading-p) + (org-forward-heading-same-level nil t) + (let* ((info (org-babel-get-src-block-info t)) + (ref (cdr (assq :noweb-ref (nth 2 info))))) + (push info (gethash ref cache)))))) + (funcall expand-references id cache))))) + ;; Interpose PREFIX between every line. + (mapconcat #'identity + (split-string expansion "[\n\r]") + (concat "\n" prefix)))))) + body t t 2))) (defun org-babel--script-escape-inner (str) (let (in-single in-double backslash out) @@ -2931,30 +2994,41 @@ situations in which is it not appropriate." (defun org-babel--string-to-number (string) "If STRING represents a number return its value. Otherwise return nil." - (and (string-match-p "\\`-?\\([0-9]\\|\\([1-9]\\|[0-9]*\\.\\)[0-9]*\\)\\'" string) - (string-to-number string))) + (unless (or (string-match-p "\\s-" (org-trim string)) + (not (string-match-p "^[0-9-e.+ ]+$" string))) + (let ((interned-string (ignore-errors (read string)))) + (when (numberp interned-string) + interned-string)))) (defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. If the table is trivial, then return it as a scalar." - (save-window-excursion - (let ((result - (with-temp-buffer - (condition-case err - (progn - (org-table-import file-name separator) - (delete-file file-name) - (delq nil - (mapcar (lambda (row) - (and (not (eq row 'hline)) - (mapcar #'org-babel-string-read row))) - (org-table-to-lisp)))) - (error (message "Error reading results: %s" err) nil))))) - (pcase result - (`((,scalar)) scalar) - (`((,_ ,_ . ,_)) result) - (`(,scalar) scalar) - (_ result))))) + (let ((result + (with-temp-buffer + (condition-case err + (progn + (insert-file-contents file-name) + (delete-file file-name) + (let ((pmax (point-max))) + ;; If the file was empty, don't bother trying to + ;; convert the table. + (when (> pmax 1) + (org-table-convert-region (point-min) pmax separator) + (delq nil + (mapcar (lambda (row) + (and (not (eq row 'hline)) + (mapcar #'org-babel-string-read row))) + (org-table-to-lisp)))))) + (error + (display-warning 'org-babel + (format "Error reading results: %S" err) + :error) + nil))))) + (pcase result + (`((,scalar)) scalar) + (`((,_ ,_ . ,_)) result) + (`(,scalar) scalar) + (_ result)))) (defun org-babel-string-read (cell) "Strip nested \"s from around strings." @@ -3053,9 +3127,8 @@ of `org-babel-temporary-directory'." (if (eq t (car (file-attributes file))) (delete-directory file) (delete-file file))) - ;; We do not want to delete "." and "..". (directory-files org-babel-temporary-directory 'full - (rx (or (not ".") "...")))) + directory-files-no-dot-files-regexp)) (delete-directory org-babel-temporary-directory)) (error (message "Failed to remove temporary Org-babel directory %s" diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index b03e8fac180..190f69cbff4 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -43,6 +43,4 @@ CSS does not support sessions." (provide 'ob-css) - - ;;; ob-css.el ends here diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 369a080b987..59129503e9f 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -119,6 +119,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-ditaa) - - ;;; ob-ditaa.el ends here diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index df83068b494..669d3cdbff1 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -87,6 +87,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-dot) - - ;;; ob-dot.el ends here diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el index 65151bf291c..773edded452 100644 --- a/lisp/org/ob-ebnf.el +++ b/lisp/org/ob-ebnf.el @@ -5,7 +5,6 @@ ;; Author: Michael Gauland ;; Keywords: literate programming, reproducible research ;; Homepage: https://orgmode.org -;; Version: 1.00 ;; This file is part of GNU Emacs. @@ -24,18 +23,18 @@ ;;; Commentary: -;;; Org-Babel support for using ebnf2ps to generate encapsulated postscript -;;; railroad diagrams. It recognizes 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 customize 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. +;; Org-Babel support for using ebnf2ps to generate encapsulated postscript +;; railroad diagrams. It recognizes 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 customize 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: @@ -78,4 +77,5 @@ This function is called by `org-babel-execute-src-block'." 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 095fbdb4f54..a18038112b4 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -61,31 +61,30 @@ by `org-edit-src-code'.") (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-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)) - (org-babel-emacs-lisp-lexical lexical)))) - (org-babel-result-cond result-params - (let ((print-level nil) - (print-length nil)) - (if (or (member "scalar" result-params) - (member "verbatim" result-params)) - (format "%S" result) - (format "%s" result))) - (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)))))))) + (let* ((lexical (cdr (assq :lexical 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)) + (org-babel-emacs-lisp-lexical lexical)))) + (org-babel-result-cond result-params + (let ((print-level nil) + (print-length nil)) + (if (or (member "scalar" result-params) + (member "verbatim" result-params)) + (format "%S" result) + (format "%s" result))) + (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-emacs-lisp-lexical (lexical) "Interpret :lexical source block argument. @@ -108,6 +107,4 @@ corresponding :lexical source block argument." (provide 'ob-emacs-lisp) - - ;;; ob-emacs-lisp.el ends here diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index a939d934d94..c11ebf19e93 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -144,6 +144,4 @@ This buffer is named by `org-babel-error-buffer-name'." (provide 'ob-eval) - - ;;; ob-eval.el ends here diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index bbf9b55a300..46506fcfddc 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -33,6 +33,7 @@ (declare-function org-escape-code-in-string "org-src" (s)) (declare-function org-export-copy-buffer "ox" ()) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-in-archived-heading-p "org" (&optional no-inheritance)) (defvar org-src-preserve-indentation) @@ -157,7 +158,8 @@ this template." ;; encountered. (goto-char (point-min)) (while (re-search-forward regexp nil t) - (unless (save-match-data (org-in-commented-heading-p)) + (unless (save-match-data (or (org-in-commented-heading-p) + (org-in-archived-heading-p))) (let* ((object? (match-end 1)) (element (save-match-data (if object? (org-element-context) @@ -403,9 +405,7 @@ inhibit insertion of results into the buffer." (`lob (save-excursion (goto-char (nth 5 info)) - (let (org-confirm-babel-evaluate) - (org-babel-execute-src-block nil info))))))))) - + (org-babel-execute-src-block nil info)))))))) (provide 'ob-exp) diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el index aef6784ca48..b6191c30719 100644 --- a/lisp/org/ob-forth.el +++ b/lisp/org/ob-forth.el @@ -76,7 +76,8 @@ This function is called by `org-babel-execute-src-block'." ;; Report errors. (org-babel-eval-error-notify 1 (buffer-substring - (+ (match-beginning 0) 1) (point-max))) nil)))) + (+ (match-beginning 0) 1) (point-max))) + nil)))) (split-string (org-trim (org-babel-expand-body:generic body params)) "\n" diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index 154465f28e1..279ca6ceba1 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -101,12 +101,13 @@ its header arguments." (concat ;; variables (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") - body) params) + body) + params) body) "\n") "\n"))) (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)) + (if (string-match "^[ \t]*program\\>" (capitalize body)) (let ((vars (org-babel--get-vars params))) (when vars (error "Cannot use :vars if `program' statement is present")) body) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index d11c55f7590..62ab04d94a7 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -35,7 +35,7 @@ ;; - gnuplot :: http://www.gnuplot.info/ ;; -;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html +;; - gnuplot-mode :: you can search the web for the latest active one. ;;; Code: (require 'ob) @@ -278,6 +278,4 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (provide 'ob-gnuplot) - - ;;; ob-gnuplot.el ends here diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el index 38e2a169cee..caf35350c5c 100644 --- a/lisp/org/ob-groovy.el +++ b/lisp/org/ob-groovy.el @@ -65,7 +65,6 @@ This function is called by `org-babel-execute-src-block'." (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 } @@ -74,7 +73,6 @@ This function is called by `org-babel-execute-src-block'." println(new Runner().run()) ") - (defun org-babel-groovy-evaluate (session body &optional result-type result-params) "Evaluate BODY in external Groovy process. @@ -111,6 +109,4 @@ supported in Groovy." (provide 'ob-groovy) - - ;;; ob-groovy.el ends here diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index e004a3405e4..84e2d6c42bc 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -23,20 +23,19 @@ ;;; Commentary: -;; Org-Babel support for evaluating haskell source code. This one will -;; be sort of tricky because haskell programs must be compiled before +;; Org Babel support for evaluating Haskell source code. +;; Haskell programs must be compiled before ;; they can be run, but haskell code can also be run through an ;; interactive interpreter. ;; -;; For now lets only allow evaluation using the haskell interpreter. +;; By default we evaluate using the Haskell interpreter. +;; To use the compiler, specify :compile yes in the header. ;;; Requirements: -;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode -;; -;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode -;; -;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/ +;; - haskell-mode: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; - inf-haskell: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; - (optionally) lhs2tex: http://people.cs.uu.nl/andres/lhs2tex/ ;;; Code: (require 'ob) @@ -47,6 +46,7 @@ (declare-function run-haskell "ext:inf-haskell" (&optional arg)) (declare-function inferior-haskell-load-file "ext:inf-haskell" (&optional reload)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) @@ -60,8 +60,63 @@ (defvar haskell-prompt-regexp) -(defun org-babel-execute:haskell (body params) - "Execute a block of Haskell code." +(defcustom org-babel-haskell-compiler "ghc" + "Command used to compile a Haskell source code file into an executable. +May be either a command in the path, like \"ghc\" or an absolute +path name, like \"/usr/local/bin/ghc\". The command can include +a parameter, such as \"ghc -v\"." + :group 'org-babel + :package-version '(Org "9.4") + :type 'string) + +(defconst org-babel-header-args:haskell '(compile . :any) + "Haskell-specific header arguments.") + +(defun org-babel-haskell-execute (body params) + "This function should only be called by `org-babel-execute:haskell'" + (let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs")) + (tmp-bin-file + (org-babel-process-file-name + (org-babel-temp-file "Haskell-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)) + " "))) + (with-temp-file tmp-src-file (insert body)) + (org-babel-eval + (format "%s -o %s %s %s %s" + org-babel-haskell-compiler + tmp-bin-file + flags + (org-babel-process-file-name tmp-src-file) + libs) + "") + (let ((results (org-babel-eval (concat tmp-bin-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 "Haskell-"))) + (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-interpret-haskell (body params) (require 'inf-haskell) (add-hook 'inferior-haskell-hook (lambda () @@ -87,7 +142,7 @@ (org-babel-reassemble-table (let ((result (pcase result-type - (`output (mapconcat #'identity (reverse (cdr results)) "\n")) + (`output (mapconcat #'identity (reverse results) "\n")) (`value (car results))))) (org-babel-result-cond (cdr (assq :result-params params)) result (org-babel-script-escape result))) @@ -96,6 +151,13 @@ (org-babel-pick-name (cdr (assq :rowname-names params)) (cdr (assq :rowname-names params)))))) +(defun org-babel-execute:haskell (body params) + "Execute a block of Haskell code." + (let ((compile (string= "yes" (cdr (assq :compile params))))) + (if (not compile) + (org-babel-interpret-haskell body params) + (org-babel-haskell-execute body 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 @@ -215,6 +277,4 @@ constructs (header arguments, no-web syntax etc...) are ignored." (provide 'ob-haskell) - - ;;; ob-haskell.el ends here diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el index 06d03b6754d..ff451befa26 100644 --- a/lisp/org/ob-hledger.el +++ b/lisp/org/ob-hledger.el @@ -30,6 +30,8 @@ ;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var). ;; So make ~/.hledger.journal a symbolic link to the real file if necessary. +;; TODO Unit tests are more than welcome, too. + ;;; Code: (require 'ob) @@ -64,7 +66,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-hledger) - - ;;; ob-hledger.el ends here -;; TODO Unit tests are more than welcome, too. diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el index 4d1f15429d2..46e721b7ae7 100644 --- a/lisp/org/ob-io.el +++ b/lisp/org/ob-io.el @@ -90,7 +90,6 @@ in BODY as elisp." raw (org-babel-script-escape raw))))))) - (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")) @@ -103,6 +102,4 @@ supported in Io." (provide 'ob-io) - - ;;; ob-io.el ends here diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el index 4b3d454898b..f5edc6d53b5 100644 --- a/lisp/org/ob-java.el +++ b/lisp/org/ob-java.el @@ -58,6 +58,7 @@ parameters may be used, like javac -verbose" (src-file (concat classname ".java")) (cmpflag (or (cdr (assq :cmpflag params)) "")) (cmdline (or (cdr (assq :cmdline params)) "")) + (cmdargs (or (cdr (assq :cmdargs params)) "")) (full-body (org-babel-expand-body:generic body params))) (with-temp-file src-file (insert full-body)) (org-babel-eval @@ -66,10 +67,10 @@ parameters may be used, like javac -verbose" (unless (or (not packagename) (file-exists-p packagename)) (make-directory packagename 'parents)) (let ((results (org-babel-eval (concat org-babel-java-command - " " cmdline " " classname) ""))) + " " cmdline " " classname " " cmdargs) ""))) (org-babel-reassemble-table (org-babel-result-cond (cdr (assq :result-params params)) - (org-babel-read results) + (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))) @@ -80,6 +81,4 @@ parameters may be used, like javac -verbose" (provide 'ob-java) - - ;;; ob-java.el ends here diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 8f66d102074..0879e689255 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -30,11 +30,11 @@ ;;; Requirements: -;; - a non-browser javascript engine such as node.js http://nodejs.org/ -;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; - a non-browser javascript engine such as node.js https://nodejs.org/ +;; or mozrepl https://wiki.github.com/bard/mozrepl/ ;; ;; - for session based evaluation mozrepl and moz.el are required see -;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; https://wiki.github.com/bard/mozrepl/emacs-integration for ;; configuration instructions ;;; Code: @@ -65,7 +65,7 @@ :safe #'stringp) (defvar org-babel-js-function-wrapper - "require('sys').print(require('sys').inspect(function(){\n%s\n}()));" + "require('process').stdout.write(require('util').inspect(function(){%s}()));" "Javascript code to print value of body.") (defun org-babel-execute:js (body params) @@ -201,6 +201,4 @@ then create. Return the initialized session." (provide 'ob-js) - - ;;; ob-js.el ends here diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index e0cc1033beb..4b343dd14d6 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -84,7 +84,8 @@ (regexp-quote (format "%S" (car pair))) (if (stringp (cdr pair)) (cdr pair) (format "%S" (cdr pair))) - body))) (org-babel--get-vars params)) + body))) + (org-babel--get-vars params)) (org-trim body)) (defun org-babel-execute:latex (body params) @@ -108,8 +109,11 @@ This function is called by `org-babel-execute-src-block'." (append (cdr (assq :packages params)) org-latex-packages-alist))) (cond ((and (string-suffix-p ".png" out-file) (not imagemagick)) - (org-create-formula-image - body out-file org-format-latex-options in-buffer)) + (let ((org-format-latex-header + (concat org-format-latex-header "\n" + (mapconcat #'identity headers "\n")))) + (org-create-formula-image + body out-file org-format-latex-options in-buffer))) ((string-suffix-p ".tikz" out-file) (when (file-exists-p out-file) (delete-file out-file)) (with-temp-file out-file @@ -221,6 +225,6 @@ This function is called by `org-babel-execute-src-block'." "Return an error because LaTeX doesn't support sessions." (error "LaTeX does not support sessions")) - (provide 'ob-latex) + ;;; ob-latex.el ends here diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index e63e10608c3..2be1a39ac7c 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -65,6 +65,4 @@ called by `org-babel-execute-src-block'." (provide 'ob-ledger) - - ;;; ob-ledger.el ends here diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index eb3372fa7bf..af66cc8a011 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -67,12 +67,15 @@ the midi file is not automatically played. Default value is t") (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) @@ -94,7 +97,8 @@ you can leave the string empty on this case." :version "24.4" :package-version '(Org . "8.2.7") :set - (lambda (_symbol value) + (lambda (symbol value) + (set symbol value) (setq org-babel-lilypond-ly-command (nth 0 value) org-babel-lilypond-pdf-command (nth 1 value) @@ -201,7 +205,7 @@ If error in compilation, attempt to mark the error in lilypond org 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*") + (org-switch-to-buffer-other-window "*lilypond*") (erase-buffer) (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file) (goto-char (point-min)) @@ -258,7 +262,7 @@ FILE-NAME is full path to lilypond file." "Mark the erroneous lines in the lilypond org buffer. FILE-NAME is full path to lilypond file. LINE is the erroneous line." - (switch-to-buffer-other-window + (org-switch-to-buffer-other-window (concat (file-name-nondirectory (org-babel-lilypond-switch-extension file-name ".org")))) (let ((temp (point))) @@ -387,7 +391,8 @@ If TEST is non-nil, the shell command is returned and is not run." (defun org-babel-lilypond-switch-extension (file-name ext) "Utility command to swap current FILE-NAME extension with EXT." (concat (file-name-sans-extension - file-name) ext)) + file-name) + ext)) (defun org-babel-lilypond-get-header-args (mode) "Default arguments to use when evaluating a lilypond source block. diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index f0e1ff63572..8b126b26f20 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -122,6 +122,4 @@ a property list containing the parameters of the block." (provide 'ob-lisp) - - ;;; ob-lisp.el ends here diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index b046b54b1d7..5e7b5145fa2 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -107,7 +107,8 @@ VARS contains resolved variable references." (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)) + (org-babel-comint-wait-for-output session)) + var-lines)) session)) (defun org-babel-load-session:lua (session body params) @@ -397,6 +398,4 @@ fd:close()" (provide 'ob-lua) - - ;;; ob-lua.el ends here diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el index 15bf6ee8308..d1f2fba9894 100644 --- a/lisp/org/ob-makefile.el +++ b/lisp/org/ob-makefile.el @@ -43,6 +43,4 @@ does not support sessions." (provide 'ob-makefile) - - ;;; ob-makefile.el ends here diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index 958357f328b..0d238a44f75 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -42,6 +42,4 @@ (provide 'ob-matlab) - - ;;; ob-matlab.el ends here diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el index 5d38cc301ad..c30b702a1ed 100644 --- a/lisp/org/ob-maxima.el +++ b/lisp/org/ob-maxima.el @@ -27,9 +27,7 @@ ;; Org-Babel support for evaluating maxima entries. ;; ;; This differs from most standard languages in that -;; ;; 1) there is no such thing as a "session" in maxima -;; ;; 2) we are adding the "cmdline" header argument ;;; Code: @@ -125,9 +123,6 @@ of the same value." (concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]") (format "%s" val))) - (provide 'ob-maxima) - - ;;; ob-maxima.el ends here diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index fa4d3e3ac34..2bd9144f4fe 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -68,8 +68,7 @@ mscgen supported formats." (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")) + (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 @@ -79,6 +78,4 @@ ERROR: no output file specified. Add \":file name.png\" to the src header")) (provide 'ob-mscgen) - - ;;; ob-msc.el ends here diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 6972dae2195..2389f192c5b 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -166,6 +166,4 @@ Emacs-lisp table, otherwise return the results as a string." (provide 'ob-ocaml) - - ;;; ob-ocaml.el ends here diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index fbfc9b97356..5cb47e956ff 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -136,7 +136,8 @@ specifying a variable of the same value." (org-babel-comint-in-buffer session (mapc (lambda (var) (end-of-line 1) (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session)) var-lines)) + (org-babel-comint-wait-for-output session)) + var-lines)) session)) (defun org-babel-matlab-initiate-session (&optional session params) @@ -230,7 +231,8 @@ value of the last statement in BODY, as elisp." org-babel-octave-eoe-indicator org-babel-octave-eoe-output) t full-body) - (insert full-body) (comint-send-input nil t)))) results) + (insert full-body) (comint-send-input nil t)))) + results) (pcase result-type (`value (org-babel-octave-import-elisp-from-file tmp-file)) @@ -259,6 +261,4 @@ This removes initial blank and comment lines and then calls (provide 'ob-octave) - - ;;; ob-octave.el ends here diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index 63165019a9a..858c78346f8 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -67,6 +67,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-org) - - ;;; ob-org.el ends here diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 2daf5774195..3e784e2a0e6 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -152,6 +152,4 @@ return the value of the last statement in BODY, as elisp." (provide 'ob-perl) - - ;;; ob-perl.el ends here diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el index ec2a228456a..96fee36fcb8 100644 --- a/lisp/org/ob-picolisp.el +++ b/lisp/org/ob-picolisp.el @@ -111,11 +111,11 @@ This function is called by `org-babel-execute-src-block'." (cond ((or (member "code" result-params) (member "pp" result-params)) - (format "(pretty (out \"/dev/null\" %s))" full-body)) + (format "(pretty (out \"%s\" %s))" null-device full-body)) ((and (member "value" result-params) (not session)) - (format "(print (out \"/dev/null\" %s))" full-body)) + (format "(print (out \"%s\" %s))" null-device full-body)) ((member "value" result-params) - (format "(out \"/dev/null\" %s)" full-body)) + (format "(out \"%s\" %s)" null-device full-body)) (t full-body))) (result (if (not (string= session-name "none")) @@ -182,6 +182,4 @@ then create. Return the initialized session." (provide 'ob-picolisp) - - ;;; ob-picolisp.el ends here diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index 5bf9e2beee4..e692bf7cdbe 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -26,12 +26,12 @@ ;; Org-Babel support for evaluating plantuml script. ;; ;; Inspired by Ian Yang's org-export-blocks-format-plantuml -;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el +;; https://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el ;;; Requirements: ;; plantuml | http://plantuml.sourceforge.net/ -;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file +;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when exec mode is `jar') ;;; Code: (require 'ob) @@ -46,6 +46,31 @@ :version "24.1" :type 'string) +(defcustom org-plantuml-exec-mode 'jar + "Method to use for PlantUML diagram generation. +`jar' means to use java together with the JAR. +The JAR can be configured via `org-plantuml-jar-path'. + +`plantuml' means to use the PlantUML executable. +The executable can be configured via `org-plantuml-executable-path'. +You can also configure extra arguments via `org-plantuml-executable-args'." + :group 'org-babel + :package-version '(Org . "9.4") + :type 'symbol + :options '(jar plantuml)) + +(defcustom org-plantuml-executable-path "plantuml" + "File name of the PlantUML executable." + :group 'org-babel + :package-version '(Org . "9.4") + :type 'string) + +(defcustom org-plantuml-executable-args (list "-headless") + "The arguments passed to plantuml executable when executing PlantUML." + :group 'org-babel + :package-version '(Org . "9.4") + :type '(repeat string)) + (defun org-babel-variable-assignments:plantuml (params) "Return a list of PlantUML statements assigning the block's variables. PARAMS is a property list of source block parameters, which may @@ -69,10 +94,11 @@ function to convert variables to PlantUML assignments. If BODY does not contain @startXXX ... @endXXX clauses, @startuml ... @enduml will be added." - (let ((assignments (org-babel-variable-assignments:plantuml params))) - (if (string-prefix-p "@start" body t) assignments - (format "@startuml\n%s\n@enduml" - (org-babel-expand-body:generic body params assignments))))) + (let ((full-body + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:plantuml params)))) + (if (string-prefix-p "@start" body t) full-body + (format "@startuml\n%s\n@enduml" full-body)))) (defun org-babel-execute:plantuml (body params) "Execute a block of plantuml code with org-babel. @@ -82,40 +108,41 @@ This function is called by `org-babel-execute-src-block'." (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) (java (or (cdr (assq :java params)) "")) + (executable (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-path) + (t "java"))) + (executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-args) + ((string= "" org-plantuml-jar-path) + (error "`org-plantuml-jar-path' is not set")) + ((not (file-exists-p org-plantuml-jar-path)) + (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) + (t (list java + "-jar" + (shell-quote-argument (expand-file-name org-plantuml-jar-path)))))) (full-body (org-babel-plantuml-make-body body 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) "tex") - " -tlatex" "") - (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) - " > " - (org-babel-process-file-name out-file))))) - (unless (file-exists-p org-plantuml-jar-path) - (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) + (cmd (mapconcat #'identity + (append + (list executable) + executable-args + (pcase (file-name-extension out-file) + ("png" '("-tpng")) + ("svg" '("-tsvg")) + ("eps" '("-teps")) + ("pdf" '("-tpdf")) + ("tex" '("-tlatex")) + ("vdx" '("-tvdx")) + ("xmi" '("-txmi")) + ("scxml" '("-tscxml")) + ("html" '("-thtml")) + ("txt" '("-ttxt")) + ("utxt" '("-utxt"))) + (list + "-p" + cmdline + "<" + (org-babel-process-file-name in-file) + ">" + (org-babel-process-file-name out-file))) + " "))) (with-temp-file in-file (insert full-body)) (message "%s" cmd) (org-babel-eval cmd "") nil)) ;; signal that output has already been written to file @@ -126,6 +153,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-plantuml) - - ;;; ob-plantuml.el ends here diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 823f6e63d57..ffb8ee855ef 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -4,6 +4,7 @@ ;; Authors: Eric Schulte ;; Dan Davison +;; Maintainer: Jack Kamm ;; Keywords: literate programming, reproducible research ;; Homepage: https://orgmode.org @@ -29,10 +30,11 @@ ;;; Code: (require 'ob) (require 'org-macs) +(require 'python) -(declare-function py-shell "ext:python-mode" (&optional argprompt)) +(declare-function py-shell "ext:python-mode" (&rest args)) (declare-function py-toggle-shells "ext:python-mode" (arg)) -(declare-function run-python "ext:python" (&optional cmd dedicated show)) +(declare-function py-shell-send-string "ext:python-mode" (strg &optional process)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) @@ -104,7 +106,8 @@ VARS contains resolved variable references." (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)) + (org-babel-comint-wait-for-output session)) + var-lines)) session)) (defun org-babel-load-session:python (session body params) @@ -177,42 +180,40 @@ Emacs-lisp table, otherwise return the results as a string." "Initiate a python session. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." - (require org-babel-python-mode) (save-window-excursion (let* ((session (if session (intern session) :default)) - (python-buffer (org-babel-python-session-buffer session)) + (py-buffer (org-babel-python-session-buffer session)) (cmd (if (member system-type '(cygwin windows-nt ms-dos)) (concat org-babel-python-command " -i") org-babel-python-command))) (cond - ((and (eq 'python org-babel-python-mode) - (fboundp 'run-python)) ; python.el - (if (not (version< "24.1" emacs-version)) - (run-python cmd) - (unless python-buffer - (setq python-buffer (org-babel-python-with-earmuffs session))) - (let ((python-shell-buffer-name - (org-babel-python-without-earmuffs python-buffer))) - (run-python cmd)))) + ((eq 'python org-babel-python-mode) ; python.el + (unless py-buffer + (setq py-buffer (org-babel-python-with-earmuffs session))) + (let ((python-shell-buffer-name + (org-babel-python-without-earmuffs py-buffer))) + (run-python cmd) + (sleep-for 0 10))) ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el + (require 'python-mode) ;; Make sure that py-which-bufname is initialized, as otherwise ;; it will be overwritten the first time a Python buffer is ;; created. (py-toggle-shells py-default-interpreter) ;; `py-shell' creates a buffer whose name is the value of ;; `py-which-bufname' with '*'s at the beginning and end - (let* ((bufname (if (and python-buffer (buffer-live-p python-buffer)) + (let* ((bufname (if (and py-buffer (buffer-live-p py-buffer)) (replace-regexp-in-string ;; zap surrounding * - "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) + "^\\*\\([^*]+\\)\\*$" "\\1" py-buffer) (concat "Python-" (symbol-name session)))) (py-which-bufname bufname)) - (py-shell) - (setq python-buffer (org-babel-python-with-earmuffs bufname)))) + (setq py-buffer (org-babel-python-with-earmuffs bufname)) + (py-shell nil nil t org-babel-python-command py-buffer nil nil t nil))) (t (error "No function available for running an inferior Python"))) (setq org-babel-python-buffers - (cons (cons session python-buffer) + (cons (cons session py-buffer) (assq-delete-all session org-babel-python-buffers))) session))) @@ -222,8 +223,9 @@ then create. Return the initialized session." (org-babel-python-session-buffer (org-babel-python-initiate-session-by-key session)))) -(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" +(defvar org-babel-python-eoe-indicator "org_babel_python_eoe" "A string to indicate that evaluation has completed.") + (defconst org-babel-python-wrapper-method " def main(): @@ -238,14 +240,39 @@ def main(): open('%s', 'w').write( pprint.pformat(main()) )") -(defconst org-babel-python--exec-tmpfile - (concat - "__org_babel_python_fname = '%s'; " - "__org_babel_python_fh = open(__org_babel_python_fname); " - "exec(compile(" - "__org_babel_python_fh.read(), __org_babel_python_fname, 'exec'" - ")); " - "__org_babel_python_fh.close()")) +(defconst org-babel-python--exec-tmpfile "\ +with open('%s') as __org_babel_python_tmpfile: + exec(compile(__org_babel_python_tmpfile.read(), __org_babel_python_tmpfile.name, 'exec'))" + "Template for Python session command with output results. + +Has a single %s escape, the tempfile containing the source code +to evaluate.") + +(defun org-babel-python-format-session-value + (src-file result-file result-params) + "Return Python code to evaluate SRC-FILE and write result to RESULT-FILE." + (format "\ +import ast +with open('%s') as __org_babel_python_tmpfile: + __org_babel_python_ast = ast.parse(__org_babel_python_tmpfile.read()) +__org_babel_python_final = __org_babel_python_ast.body[-1] +if isinstance(__org_babel_python_final, ast.Expr): + __org_babel_python_ast.body = __org_babel_python_ast.body[:-1] + exec(compile(__org_babel_python_ast, '', 'exec')) + __org_babel_python_final = eval(compile(ast.Expression( + __org_babel_python_final.value), '', 'eval')) + with open('%s', 'w') as __org_babel_python_tmpfile: + if %s: + import pprint + __org_babel_python_tmpfile.write(pprint.pformat(__org_babel_python_final)) + else: + __org_babel_python_tmpfile.write(str(__org_babel_python_final)) +else: + exec(compile(__org_babel_python_ast, '', 'exec')) + __org_babel_python_final = None" + (org-babel-process-file-name src-file 'noquote) + (org-babel-process-file-name result-file 'noquote) + (if (member "pp" result-params) "True" "False"))) (defun org-babel-python-evaluate (session body &optional result-type result-params preamble) @@ -256,6 +283,19 @@ open('%s', 'w').write( pprint.pformat(main()) )") (org-babel-python-evaluate-external-process body result-type result-params preamble))) +(defun org-babel-python--shift-right (body &optional count) + (with-temp-buffer + (python-mode) + (insert body) + (goto-char (point-min)) + (while (not (eobp)) + (unless (python-syntax-context 'string) + (python-indent-shift-right (line-beginning-position) + (line-end-position) + count)) + (forward-line 1)) + (buffer-string))) + (defun org-babel-python-evaluate-external-process (body &optional result-type result-params preamble) "Evaluate BODY in external python process. @@ -276,89 +316,70 @@ last statement in BODY, as elisp." (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-python--shift-right body) (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-trim raw))))) +(defun org-babel-python--send-string (session body) + "Pass BODY to the Python process in SESSION. +Return output." + (with-current-buffer session + (let* ((string-buffer "") + (comint-output-filter-functions + (cons (lambda (text) (setq string-buffer + (concat string-buffer text))) + comint-output-filter-functions)) + (body (format "\ +try: +%s +except: + raise +finally: + print('%s')" + (org-babel-python--shift-right body 4) + org-babel-python-eoe-indicator))) + (if (not (eq 'python-mode org-babel-python-mode)) + (let ((python-shell-buffer-name + (org-babel-python-without-earmuffs session))) + (python-shell-send-string body)) + (require 'python-mode) + (py-shell-send-string body (get-buffer-process session))) + ;; same as `python-shell-comint-end-of-output-p' in emacs-25.1+ + (while (not (string-match + org-babel-python-eoe-indicator + string-buffer)) + (accept-process-output (get-buffer-process (current-buffer)))) + (org-babel-chomp (substring string-buffer 0 (match-beginning 0)))))) + (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 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 - "import pprint" - (format "open('%s', 'w').write(pprint.pformat(_))" - (org-babel-process-file-name tmp-file 'noquote))) - (list (format "open('%s', 'w').write(str(_))" - (org-babel-process-file-name tmp-file - 'noquote))))))) - (last-indent 0) - (input-body (lambda (body) - (dolist (line (split-string body "[\r\n]")) - ;; Insert a blank line to end an indent - ;; block. - (let ((curr-indent (string-match "\\S-" line))) - (if curr-indent - (progn - (when (< curr-indent last-indent) - (insert "") - (funcall send-wait)) - (setq last-indent curr-indent)) - (setq last-indent 0))) - (insert line) - (funcall send-wait)) - (funcall send-wait))) + (let* ((tmp-src-file (org-babel-temp-file "python-")) (results - (pcase result-type - (`output - (let ((body (if (string-match-p ".\n+." body) ; Multiline - (let ((tmp-src-file (org-babel-temp-file - "python-"))) - (with-temp-file tmp-src-file (insert body)) - (format org-babel-python--exec-tmpfile - tmp-src-file)) - body))) - (mapconcat - #'org-trim - (butlast - (org-babel-comint-with-output - (session org-babel-python-eoe-indicator t body) - (funcall input-body body) - (funcall send-wait) (funcall send-wait) - (insert org-babel-python-eoe-indicator) - (funcall send-wait)) - 2) "\n"))) - (`value - (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-comint-with-output - (session org-babel-python-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-python-eoe-indicator) - (funcall send-wait))) - (org-babel-eval-read-file tmp-file)))))) - (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) - (org-babel-result-cond result-params - results - (org-babel-python-table-or-string results))))) + (progn + (with-temp-file tmp-src-file (insert body)) + (pcase result-type + (`output + (let ((body (format org-babel-python--exec-tmpfile + (org-babel-process-file-name + tmp-src-file 'noquote)))) + (org-babel-python--send-string session body))) + (`value + (let* ((tmp-results-file (org-babel-temp-file "python-")) + (body (org-babel-python-format-session-value + tmp-src-file tmp-results-file result-params))) + (org-babel-python--send-string session body) + (sleep-for 0 10) + (org-babel-eval-read-file tmp-results-file))))))) + (org-babel-result-cond result-params + results + (org-babel-python-table-or-string results)))) (defun org-babel-python-read-string (string) "Strip \\='s from around Python string." @@ -369,6 +390,4 @@ last statement in BODY, as elisp." (provide 'ob-python) - - ;;; ob-python.el ends here diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 19905bf6b97..394c4ffb59d 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -143,7 +143,8 @@ Emacs Lisp representation of the value of the variable." (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))) + new-header-args) + args))) (setq ref new-refere))) (when (string-match "^\\(.+\\):\\(.+\\)$" ref) (setq split-file (match-string 1 ref)) @@ -240,7 +241,6 @@ to \"0:-1\"." "Split ARG-STRING into top-level arguments of balanced parenthesis." (mapcar #'org-trim (org-babel-balanced-split arg-string 44))) - (provide 'ob-ref) ;;; ob-ref.el ends here diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 90956271cf5..5ed29f8891a 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -30,16 +30,17 @@ ;; - ruby and irb executables :: http://www.ruby-lang.org/ ;; ;; - ruby-mode :: Can be installed through ELPA, or from -;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el ;; ;; - inf-ruby mode :: Can be installed through ELPA, or from -;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el +;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el ;;; Code: (require 'ob) (require 'org-macs) -(declare-function run-ruby "ext:inf-ruby" (&optional command name)) +(declare-function run-ruby-or-pop-to-buffer "ext:inf-ruby" (command &optional name buffer)) +(declare-function inf-ruby-buffer "ext:inf-ruby" ()) (declare-function xmp "ext:rcodetools" (&optional option)) (defvar inf-ruby-default-implementation) @@ -51,7 +52,8 @@ (defvar org-babel-default-header-args:ruby '()) (defvar org-babel-ruby-command "ruby" - "Name of command to use for executing ruby code.") + "Name of command to use for executing ruby code. +It's possible to override it by using a header argument `:ruby'") (defcustom org-babel-ruby-hline-to "nil" "Replace hlines in incoming tables with this when translating to ruby." @@ -71,9 +73,12 @@ "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 (assq :session params)))) + (cdr (assq :session params)) params)) (result-params (cdr (assq :result-params params))) (result-type (cdr (assq :result-type params))) + (org-babel-ruby-command + (or (cdr (assq :ruby params)) + org-babel-ruby-command)) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ruby params))) (result (if (member "xmp" result-params) @@ -103,7 +108,8 @@ This function is called by `org-babel-execute-src-block'." (mapc (lambda (var) (insert var) (comint-send-input nil t) (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines)) + (sit-for .1) (goto-char (point-max))) + var-lines)) session)) (defun org-babel-load-session:ruby (session body params) @@ -147,17 +153,21 @@ Emacs-lisp table, otherwise return the results as a string." 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* ((cmd (cdr (assoc inf-ruby-default-implementation - inf-ruby-implementations))) + (let* ((cmd (cdr (or (assq :ruby params) + (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) + (run-ruby-or-pop-to-buffer + cmd (or session "ruby") + (unless session + (inf-ruby-buffer))) (current-buffer))))) (if (org-babel-comint-buffer-livep session-buffer) (progn (sit-for .25) session-buffer) @@ -263,6 +273,4 @@ return the value of the last statement in BODY, as elisp." (provide 'ob-ruby) - - ;;; ob-ruby.el ends here diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index 60c081dcb38..33d8ef7e471 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -35,7 +35,7 @@ ;;; Requirements: -;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el +;; - sass-mode :: https://github.com/nex3/haml/blob/master/extra/sass-mode.el ;;; Code: (require 'ob) @@ -65,6 +65,4 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-sass) - - ;;; ob-sass.el ends here diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index bfd53d5d8bb..3eee8213dfd 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -43,6 +43,7 @@ (require 'geiser-impl nil t) (defvar geiser-repl--repl) ; Defined in geiser-repl.el (defvar geiser-impl--implementation) ; Defined in geiser-impl.el +(defvar geiser-scheme-implementation) ; Defined in geiser-impl.el (defvar geiser-default-implementation) ; Defined in geiser-impl.el (defvar geiser-active-implementations) ; Defined in geiser-impl.el (defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el @@ -71,7 +72,8 @@ (defun org-babel-expand-body:scheme (body params) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (org-babel--get-vars params)) - (prepends (cdr (assq :prologue params)))) + (prepends (cdr (assq :prologue params))) + (postpends (cdr (assq :epilogue params)))) (concat (and prepends (concat prepends "\n")) (if (null vars) body (format "(let (%s)\n%s\n)" @@ -80,7 +82,8 @@ (format "%S" (print `(,(car var) ',(cdr var))))) vars "\n ") - body))))) + body)) + (and postpends (concat "\n" postpends))))) (defvar org-babel-scheme-repl-map (make-hash-table :test #'equal) @@ -175,7 +178,8 @@ is true; otherwise returns the last value." (geiser-debug-show-debug-p nil)) (let ((ret (geiser-eval-region (point-min) (point-max)))) (setq result (if output - (geiser-eval--retort-output ret) + (or (geiser-eval--retort-output ret) + "Geiser Interpreter produced no output") (geiser-eval--retort-result-str ret ""))))) (when (not repl) (save-current-buffer (set-buffer repl-buffer) @@ -208,6 +212,7 @@ This function is called by `org-babel-execute-src-block'." (let* ((result-type (cdr (assq :result-type params))) (impl (or (when (cdr (assq :scheme params)) (intern (cdr (assq :scheme params)))) + geiser-scheme-implementation geiser-default-implementation (car geiser-active-implementations))) (session (org-babel-scheme-make-session-name diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index ad00ee070d4..8a11f7a3b6e 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -40,7 +40,8 @@ In case you want to use a different screen than one selected by your $PATH") (defvar org-babel-default-header-args:screen - '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) + `((:results . "silent") (:session . "default") (:cmd . "sh") + (:terminal . "xterm") (:screenrc . ,null-device)) "Default arguments to use when running screen source blocks.") (defun org-babel-execute:screen (body params) @@ -59,11 +60,11 @@ In case you want to use a different screen than one selected by your $PATH") (let* ((session (cdr (assq :session params))) (cmd (cdr (assq :cmd params))) (terminal (cdr (assq :terminal params))) + (screenrc (cdr (assq :screenrc 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 - "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) - ,cmd)) + "-c" ,screenrc "-mS" ,session ,cmd)) ;; XXX: Is there a better way than the following? (while (not (org-babel-screen-session-socketname session)) ;; wait until screen session is available before returning @@ -97,9 +98,8 @@ In case you want to use a different screen than one selected by your $PATH") nil (mapcar (lambda (x) - (when (string-match - (concat "org-babel-session-" session) x) - x)) + (and (string-match-p (regexp-quote session) x) + x)) sockets))))) (when match-socket (car (split-string match-socket))))) @@ -108,6 +108,7 @@ In case you want to use a different screen than one selected by your $PATH") (let ((tmpfile (org-babel-temp-file "screen-"))) (with-temp-file tmpfile (insert body) + (insert "\n") ;; org-babel has superfluous spaces (goto-char (point-min)) @@ -126,7 +127,7 @@ The terminal should shortly flicker." ;; XXX: need to find a better way to do the following (while (not (file-readable-p tmpfile)) ;; do something, otherwise this will be optimized away - (format "org-babel-screen: File not readable yet.")) + (message "org-babel-screen: File not readable yet.")) (setq tmp-string (with-temp-buffer (insert-file-contents-literally tmpfile) (buffer-substring (point-min) (point-max)))) @@ -138,6 +139,4 @@ The terminal should shortly flicker." (provide 'ob-screen) - - ;;; ob-screen.el ends here diff --git a/lisp/org/ob-sed.el b/lisp/org/ob-sed.el index f926da890fc..6914cd3bfee 100644 --- a/lisp/org/ob-sed.el +++ b/lisp/org/ob-sed.el @@ -4,7 +4,6 @@ ;; Author: Bjarte Johansen ;; Keywords: literate programming, reproducible research -;; Version: 0.1.1 ;; This file is part of GNU Emacs. @@ -68,7 +67,8 @@ function is called by `org-babel-execute-src-block'." (in-file (cdr (assq :in-file params))) (code-file (let ((file (org-babel-temp-file "sed-"))) (with-temp-file file - (insert body)) file)) + (insert body)) + file)) (stdin (let ((stdin (cdr (assq :stdin params)))) (when stdin (let ((tmp (org-babel-temp-file "sed-stdin-")) @@ -102,4 +102,5 @@ function is called by `org-babel-execute-src-block'." (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (provide 'ob-sed) + ;;; ob-sed.el ends here diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el index 1383f42f259..c08ba50fe7e 100644 --- a/lisp/org/ob-shell.el +++ b/lisp/org/ob-shell.el @@ -71,6 +71,19 @@ outside the Customize interface." (set-default symbol value) (org-babel-shell-initialize))) +(defcustom org-babel-shell-results-defaults-to-output t + "Let shell execution defaults to \":results output\". + +When set to t, use \":results output\" when no :results setting +is set. This is especially useful for inline source blocks. + +When set to nil, stick to the convention of using :results value +as the default setting when no :results is set, the \"value\" of +a shell execution being its exit code." + :group 'org-babel + :type 'boolean + :package-version '(Org . "9.4")) + (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'." @@ -79,9 +92,17 @@ This function is called by `org-babel-execute-src-block'." (stdin (let ((stdin (cdr (assq :stdin params)))) (when stdin (org-babel-sh-var-to-string (org-babel-ref-resolve stdin))))) + (results-params (cdr (assq :result-params params))) + (value-is-exit-status + (or (and + (equal '("replace") results-params) + (not org-babel-shell-results-defaults-to-output)) + (member "value" results-params))) (cmdline (cdr (assq :cmdline params))) - (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:shell params)))) + (full-body (concat + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:shell params)) + (when value-is-exit-status "\necho $?")))) (org-babel-reassemble-table (org-babel-sh-evaluate session full-body params stdin cmdline) (org-babel-pick-name @@ -96,7 +117,8 @@ This function is called by `org-babel-execute-src-block'." (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)) + (org-babel-comint-wait-for-output session)) + var-lines)) session)) (defun org-babel-load-session:shell (session body params) @@ -129,15 +151,15 @@ This function is called by `org-babel-execute-src-block'." (varname values &optional sep hline) "Return 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"))) + 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) "Represent the parameters as useful Bash shell variables." @@ -208,6 +230,12 @@ 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* ((shebang (cdr (assq :shebang params))) + (results-params (cdr (assq :result-params params))) + (value-is-exit-status + (or (and + (equal '("replace") results-params) + (not org-babel-shell-results-defaults-to-output)) + (member "value" results-params))) (results (cond ((or stdin cmdline) ; external shell script w/STDIN @@ -259,8 +287,9 @@ return the value of the last statement in BODY." (insert body)) (set-file-modes script-file #o755) (org-babel-eval script-file ""))) - (t - (org-babel-eval shell-file-name (org-trim body)))))) + (t (org-babel-eval shell-file-name (org-trim body)))))) + (when value-is-exit-status + (setq results (car (reverse (split-string results "\n" t))))) (when results (let ((result-params (cdr (assq :result-params params)))) (org-babel-result-cond result-params @@ -277,6 +306,4 @@ return the value of the last statement in BODY." (provide 'ob-shell) - - ;;; ob-shell.el ends here diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el index 1ce7113294c..0e012ac82b0 100644 --- a/lisp/org/ob-shen.el +++ b/lisp/org/ob-shen.el @@ -75,4 +75,5 @@ This function is called by `org-babel-execute-src-block'." (error results)))))) (provide 'ob-shen) + ;;; ob-shen.el ends here diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 59cf19568ed..7c359b988d3 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -55,7 +55,7 @@ ;; - dbi ;; - mssql ;; - sqsh -;; - postgresql +;; - postgresql (postgres) ;; - oracle ;; - vertica ;; @@ -73,6 +73,7 @@ (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)) +(declare-function sql-set-product "sql" (product)) (defvar sql-connection-alist) (defvar org-babel-default-header-args:sql '()) @@ -92,6 +93,13 @@ (org-babel-sql-expand-vars body (org-babel--get-vars params))) +(defun org-babel-edit-prep:sql (info) + "Set `sql-product' in Org edit buffer. +Set `sql-product' in Org edit buffer according to the +corresponding :engine source block header argument." + (let ((product (cdr (assq :engine (nth 2 info))))) + (sql-set-product product))) + (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 @@ -211,64 +219,64 @@ This function is called by `org-babel-execute-src-block'." (out-file (or (cdr (assq :out-file params)) (org-babel-temp-file "sql-out-"))) (header-delim "") - (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))) - (`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 "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - (`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 ""))) - (`sqsh (format "sqsh %s %s -i %s -o %s -m csv" + (command (cl-case (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))) + (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" (or cmdline "") - (org-babel-sql-dbstring-sqsh + (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)))) - (`vertica (format "vsql %s -f %s -o %s %s" - (org-babel-sql-dbstring-vertica - dbhost dbport dbuser dbpassword database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (`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))))) + (mysql (format "mysql %s %s %s < %s > %s" + (org-babel-sql-dbstring-mysql + dbhost dbport dbuser dbpassword database) + (if colnames-p "" "-N") + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ((postgresql postgres) (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 ""))) + (sqsh (format "sqsh %s %s -i %s -o %s -m csv" + (or cmdline "") + (org-babel-sql-dbstring-sqsh + 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)))) + (vertica (format "vsql %s -f %s -o %s %s" + (org-babel-sql-dbstring-vertica + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (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))) + (t (user-error "No support for the %s SQL engine" engine))))) (with-temp-file in-file (insert (pcase (intern engine) @@ -301,7 +309,7 @@ SET COLSEP '|' (progn (insert-file-contents-literally out-file) (buffer-string))) (with-temp-buffer (cond - ((memq (intern engine) '(dbi mysql postgresql sqsh vertica)) + ((memq (intern engine) '(dbi mysql postgresql postgres sqsh vertica)) ;; Add header row delimiter after column-names header in first line (cond (colnames-p @@ -365,6 +373,4 @@ SET COLSEP '|' (provide 'ob-sql) - - ;;; ob-sql.el ends here diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 957ee653479..22d018bcf5a 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -133,11 +133,12 @@ This function is called by `org-babel-execute-src-block'." "If RESULT looks like a trivial table, then unwrap it." (if (and (equal 1 (length result)) (equal 1 (length (car result)))) - (org-babel-read (caar result)) + (org-babel-read (caar result) t) (mapcar (lambda (row) (if (eq 'hline row) 'hline - (mapcar #'org-babel-string-read row))) result))) + (mapcar #'org-babel-string-read row))) + result))) (defun org-babel-sqlite-offset-colnames (table headers-p) "If HEADERS-P is non-nil then offset the first row as column names." @@ -152,6 +153,4 @@ Prepare SESSION according to the header arguments specified in PARAMS." (provide 'ob-sqlite) - - ;;; ob-sqlite.el ends here diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el index c563a6c3e55..00aa8fb28c8 100644 --- a/lisp/org/ob-stan.el +++ b/lisp/org/ob-stan.el @@ -41,7 +41,7 @@ ;; For more information and usage examples, visit ;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html ;; -;; [1] http://mc-stan.org/ +;; [1] https://mc-stan.org/ ;;; Code: (require 'ob) @@ -82,4 +82,5 @@ Otherwise, write the Stan code directly to the named file." (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 3132965c702..77daf7be4ef 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -62,7 +62,8 @@ 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)) - (when (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. @@ -147,6 +148,4 @@ as shown in the example below. (provide 'ob-table) - - ;;; ob-table.el ends here diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 946039869fb..b74b3fa0c49 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -41,6 +41,7 @@ (declare-function org-element-type "org-element" (element)) (declare-function org-heading-components "org" ()) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-in-archived-heading-p "org" (&optional no-inheritance)) (declare-function outline-previous-heading "outline" ()) (defcustom org-babel-tangle-lang-exts @@ -166,13 +167,14 @@ evaluating BODY." (def-edebug-spec org-babel-with-temp-filebuffer (form body)) ;;;###autoload -(defun org-babel-tangle-file (file &optional target-file lang) +(defun org-babel-tangle-file (file &optional target-file lang-re) "Extract the bodies of source code blocks in FILE. Source code blocks are extracted with `org-babel-tangle'. Optional argument TARGET-FILE can be used to specify a default -export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language. -Return a list whose CAR is the tangled file name." +export file for all source blocks. Optional argument LANG-RE can +be used to limit the exported source code blocks by languages +matching a regular expression. Return a list whose CAR is the +tangled file name." (interactive "fFile to tangle: \nP") (let ((visited-p (find-buffer-visiting (expand-file-name file))) to-be-removed) @@ -180,7 +182,7 @@ Return a list whose CAR is the tangled file name." (save-window-excursion (find-file file) (setq to-be-removed (current-buffer)) - (mapcar #'expand-file-name (org-babel-tangle nil target-file lang))) + (mapcar #'expand-file-name (org-babel-tangle nil target-file lang-re))) (unless visited-p (kill-buffer to-be-removed))))) @@ -192,7 +194,7 @@ Return a list whose CAR is the tangled file name." (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) ;;;###autoload -(defun org-babel-tangle (&optional arg target-file lang) +(defun org-babel-tangle (&optional arg target-file lang-re) "Write code blocks to source-specific files. Extract the bodies of all source code blocks from the current file into their own source-specific files. @@ -200,8 +202,9 @@ With one universal prefix argument, only tangle the block at point. When two universal prefix arguments, only tangle blocks for the tangle file of the block at point. Optional argument TARGET-FILE can be used to specify a default -export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language." +export file for all source blocks. Optional argument LANG-RE can +be used to limit the exported source code blocks by languages +matching a regular expression." (interactive "P") (run-hooks 'org-babel-pre-tangle-hook) ;; Possibly Restrict the buffer to the current code block @@ -286,7 +289,7 @@ used to limit the exported source code blocks by language." specs))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t) - (org-babel-tangle-collect-blocks lang tangle-file))) + (org-babel-tangle-collect-blocks lang-re tangle-file))) (message "Tangled %d code block%s from %s" block-counter (if (= block-counter 1) "" "s") (file-name-nondirectory @@ -364,13 +367,14 @@ that the appropriate major-mode is set. SPEC has the form: (org-fill-template org-babel-tangle-comment-format-end link-data))))) -(defun org-babel-tangle-collect-blocks (&optional language tangle-file) +(defun org-babel-tangle-collect-blocks (&optional lang-re tangle-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." +Optional argument LANG-RE can be used to limit the collected +source code blocks by languages matching a regular expression. +Optional argument TANGLE-FILE can be used to limit the collected +code blocks by target file." (let ((counter 0) last-heading-pos blocks) (org-babel-map-src-blocks (buffer-file-name) (let ((current-heading-pos @@ -379,13 +383,14 @@ can be used to limit the collected code blocks by target file." (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) + (unless (or (org-in-commented-heading-p) + (org-in-archived-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)))) + (and lang-re (not (string-match-p lang-re src-lang)))) ;; Add the spec for this block to blocks under its ;; language. (let ((by-lang (assoc src-lang blocks)) @@ -471,9 +476,9 @@ non-nil, return the full association list to be used by file) (if (and org-babel-tangle-use-relative-file-links (string-match org-link-types-re link) - (string= (match-string 0 link) "file")) + (string= (match-string 1 link) "file")) (concat "file:" - (file-relative-name (match-string 1 link) + (file-relative-name (substring link (match-end 0)) (file-name-directory (cdr (assq :tangle params))))) link) @@ -513,14 +518,16 @@ which enable the original code blocks to be found." (goto-char (point-min)) (let ((counter 0) new-body end) (while (re-search-forward org-link-bracket-re nil t) - (when (re-search-forward - (concat " " (regexp-quote (match-string 2)) " ends here")) - (setq end (match-end 0)) - (forward-line -1) - (save-excursion - (when (setq new-body (org-babel-tangle-jump-to-org)) - (org-babel-update-block-body new-body))) - (setq counter (+ 1 counter))) + (if (and (match-string 2) + (re-search-forward + (concat " " (regexp-quote (match-string 2)) " ends here") nil t)) + (progn (setq end (match-end 0)) + (forward-line -1) + (save-excursion + (when (setq new-body (org-babel-tangle-jump-to-org)) + (org-babel-update-block-body new-body))) + (setq counter (+ 1 counter))) + (setq end (point))) (goto-char end)) (prog1 counter (message "Detangled %d code blocks" counter))))) @@ -541,7 +548,8 @@ which enable the original code blocks to be found." (save-match-data (re-search-forward (concat " " (regexp-quote block-name) - " ends here") nil t) + " ends here") + nil t) (setq end (line-beginning-position)))))))) (unless (and start (< start mid) (< mid end)) (error "Not in tangled code")) diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el index e9c214f7dfc..b1c22756226 100644 --- a/lisp/org/ob-vala.el +++ b/lisp/org/ob-vala.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; ob-vala.el provides Babel support for the Vala language -;; (see http://live.gnome.org/Vala for details) +;; (see https://live.gnome.org/Vala for details) ;;; Requirements: diff --git a/lisp/org/ol-bbdb.el b/lisp/org/ol-bbdb.el index 9f522ce5bdc..73627b901fa 100644 --- a/lisp/org/ol-bbdb.el +++ b/lisp/org/ol-bbdb.el @@ -98,7 +98,7 @@ (require 'org-macs) (require 'ol) -;; Declare functions and variables +;;; Declare functions and variables (declare-function bbdb "ext:bbdb-com" (string elidep)) (declare-function bbdb-company "ext:bbdb-com" (string elidep)) @@ -126,9 +126,9 @@ (declare-function diary-ordinal-suffix "diary-lib" (n)) -(with-no-warnings (defvar date)) ;unprefixed, from calendar.el +(with-no-warnings (defvar date)) ; unprefixed, from calendar.el -;; Customization +;;; Customization (defgroup org-bbdb-anniversaries nil "Customizations for including anniversaries from BBDB into Agenda." @@ -162,13 +162,13 @@ used." '(("birthday" . (lambda (name years suffix) (concat "Birthday: [[bbdb:" name "][" name " (" - (format "%s" years) ; handles numbers as well as strings - suffix ")]]"))) + (format "%s" years) ; handles numbers as well as strings + suffix ")]]"))) ("wedding" . (lambda (name years suffix) (concat "[[bbdb:" name "][" name "'s " - (format "%s" years) - suffix " wedding anniversary]]")))) + (format "%s" years) + suffix " wedding anniversary]]")))) "How different types of anniversaries should be formatted. An alist of elements (STRING . FORMAT) where STRING is the name of an anniversary class and format is either: @@ -221,7 +221,8 @@ date year)." :complete #'org-bbdb-complete-link :store #'org-bbdb-store-link) -;; Implementation +;;; Implementation + (defun org-bbdb-store-link () "Store a link to a BBDB database entry." (when (eq major-mode 'bbdb-mode) @@ -236,7 +237,7 @@ date year)." :link link :description name) link))) -(defun org-bbdb-export (path desc format) +(defun org-bbdb-export (path desc format _) "Create the export version of a BBDB link specified by PATH or DESC. If exporting to either HTML or LaTeX FORMAT the link will be italicized, in all other cases it is left unchanged." @@ -249,7 +250,7 @@ italicized, in all other cases it is left unchanged." (format "%s" desc)) (t desc))) -(defun org-bbdb-open (name) +(defun org-bbdb-open (name _) "Follow a BBDB link to NAME." (require 'bbdb-com) (let ((inhibit-redisplay (not debug-on-error))) @@ -362,7 +363,9 @@ This is used by Org to re-create the anniversary hash table." ;;;###autoload (defun org-bbdb-anniversaries () - "Extract anniversaries from BBDB for display in the agenda." + "Extract anniversaries from BBDB for display in the agenda. +When called programmatically, this function expects the `date' +variable to be globally bound." (require 'bbdb) (require 'diary-lib) (unless (hash-table-p org-bbdb-anniv-hash) @@ -380,7 +383,7 @@ This is used by Org to re-create the anniversary hash table." (text ()) rec recs) - ;; we don't want to miss people born on Feb. 29th + ;; We don't want to miss people born on Feb. 29th (when (and (= m 3) (= d 1) (not (null (gethash (list 2 29) org-bbdb-anniv-hash))) (not (calendar-leap-year-p y))) @@ -415,8 +418,9 @@ 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: +;;; Return the 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) ;;; @@ -442,15 +446,14 @@ for the same event depending on if it occurs in the next few days or far away in the future." (let ((delta (- (calendar-absolute-from-gregorian anniv-date) (calendar-absolute-from-gregorian agenda-date)))) - (cond ((= delta 0) " -- today\\&") ((= delta 1) " -- tomorrow\\&") - ((< delta org-bbdb-general-anniversary-description-after) (format " -- in %d days\\&" delta)) + ((< delta org-bbdb-general-anniversary-description-after) + (format " -- in %d days\\&" delta)) ((pcase-let ((`(,month ,day ,year) anniv-date)) (format " -- %d-%02d-%02d\\&" year month day)))))) - (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))) diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el index f139d645dad..e8f246e7f64 100644 --- a/lisp/org/ol-bibtex.el +++ b/lisp/org/ol-bibtex.el @@ -95,7 +95,7 @@ ;; 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 +;; of Austin Frank: https://orgmode.org/list/m0myu03vbx.fsf@gmail.com ;; and then implemented by Bastien Guerry. ;; ;; Eric Schulte eventually added the functions for translating between @@ -134,7 +134,6 @@ (declare-function org-insert-heading "org" (&optional arg invisible-ok top)) (declare-function org-map-entries "org" (func &optional match scope &rest skip)) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-open-file "org" (path &optional in-emacs line search)) (declare-function org-set-property "org" (property value)) (declare-function org-toggle-tag "org" (tag &optional onoff)) @@ -483,12 +482,11 @@ With optional argument OPTIONAL, also prompt for optional fields." :follow #'org-bibtex-open :store #'org-bibtex-store-link) -(defun org-bibtex-open (path) - "Visit the bibliography entry on PATH." - (let* ((search (when (string-match "::\\(.+\\)\\'" path) - (match-string 1 path))) - (path (substring path 0 (match-beginning 0)))) - (org-open-file path t nil search))) +(defun org-bibtex-open (path arg) + "Visit the bibliography entry on PATH. +ARG, when non-nil, is a universal prefix argument. See +`org-open-file' for details." + (org-link-open-as-file path arg)) (defun org-bibtex-store-link () "Store a link to a BibTeX entry." @@ -556,7 +554,8 @@ With optional argument OPTIONAL, also prompt for optional fields." ;; We construct a regexp that searches for "@entrytype{" followed by the key (goto-char (point-min)) (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" - (regexp-quote s) "[ \t\n]*,") nil t) + (regexp-quote s) "[ \t\n]*,") + nil t) (goto-char (match-beginning 0))) (if (and (match-beginning 0) (equal current-prefix-arg '(16))) ;; Use double prefix to indicate that any web link should be browsed @@ -596,7 +595,8 @@ Headlines are exported using `org-bibtex-headline'." (with-temp-file filename (insert (mapconcat #'identity bibtex-entries "\n"))) (message "Successfully exported %d BibTeX entries to %s" - (length bibtex-entries) filename) nil)))) + (length bibtex-entries) filename) + nil)))) (when error-point (goto-char error-point) (message "Bibtex error at %S" (nth 4 (org-heading-components)))))) @@ -661,7 +661,8 @@ This uses `bibtex-parse-entry'." (when (and (> (length str) 1) (= (aref str 0) (car pair)) (= (aref str (1- (length str))) (cdr pair))) - (setf str (substring str 1 (1- (length str)))))) str))) + (setf str (substring str 1 (1- (length str)))))) + str))) (push (mapcar (lambda (pair) (cons (let ((field (funcall keyword (car pair)))) diff --git a/lisp/org/ol-docview.el b/lisp/org/ol-docview.el index 22b630299bf..0c6419fbab9 100644 --- a/lisp/org/ol-docview.el +++ b/lisp/org/ol-docview.el @@ -68,7 +68,7 @@ ((eq format 'ascii) (format "%s (%s)" desc path)) (t path))))) -(defun org-docview-open (link) +(defun org-docview-open (link _) (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link) (let ((path (match-string 1 link)) (page (and (match-beginning 2) @@ -98,7 +98,6 @@ and append it." "::" (read-from-minibuffer "Page:" "1"))) - (provide 'ol-docview) ;;; ol-docview.el ends here diff --git a/lisp/org/ol-eshell.el b/lisp/org/ol-eshell.el index 7e742f8892a..2bc1a2938ff 100644 --- a/lisp/org/ol-eshell.el +++ b/lisp/org/ol-eshell.el @@ -33,7 +33,7 @@ :follow #'org-eshell-open :store #'org-eshell-store-link) -(defun org-eshell-open (link) +(defun org-eshell-open (link _) "Switch to an eshell buffer and execute a command line. The link can be just a command line (executed in the default eshell buffer) or a command line prefixed by a buffer name diff --git a/lisp/org/ol-eww.el b/lisp/org/ol-eww.el index f32c06b6c89..27e32bc3a3b 100644 --- a/lisp/org/ol-eww.el +++ b/lisp/org/ol-eww.el @@ -46,17 +46,22 @@ ;;; Code: (require 'ol) (require 'cl-lib) +(require 'eww) +;; For Emacsen < 25. (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) +(org-link-set-parameters "eww" + :follow #'org-eww-open + :store #'org-eww-store-link) + +(defun org-eww-open (url _) + "Open URL with Eww in the current buffer." + (eww url)) + (defun org-eww-store-link () "Store a link to the url of an EWW buffer." (when (eq major-mode 'eww-mode) diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el index 99472315f67..af88c1a1532 100644 --- a/lisp/org/ol-gnus.el +++ b/lisp/org/ol-gnus.el @@ -34,7 +34,8 @@ (require 'gnus-sum) (require 'gnus-util) (require 'nnheader) -(require 'nnir) +(or (require 'nnselect nil t) ; Emacs >= 28 + (require 'nnir nil t)) ; Emacs < 28 (require 'ol) @@ -61,7 +62,7 @@ ;;; Customization variables (defcustom org-gnus-prefer-web-links nil - "If non-nil, `org-store-link' creates web links to Google groups or Gmane. + "If non-nil, `org-store-link' creates web links to Google groups. \\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." @@ -87,8 +88,8 @@ negates this setting for the duration of the command." (defun org-gnus-group-link (group) "Create a link to the Gnus group GROUP. If GROUP is a newsgroup and `org-gnus-prefer-web-links' is -non-nil, create a link to groups.google.com or gmane.org. -Otherwise create a link to the group inside Gnus. +non-nil, create a link to groups.google.com. 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." @@ -96,10 +97,7 @@ If `org-store-link' was called with a prefix arg the meaning of (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) - "http://news.gmane.org/" - "http://groups.google.com/group/") - unprefixed-group) + (concat "https://groups.google.com/group/" unprefixed-group) (concat "gnus:" group)))) (defun org-gnus-article-link (group newsgroups message-id x-no-archive) @@ -110,7 +108,7 @@ parameters are the Gnus GROUP, the NEWSGROUPS the article was posted to and the X-NO-ARCHIVE header value of that article. If GROUP is a newsgroup and `org-gnus-prefer-web-links' is -non-nil, create a link to groups.google.com or gmane.org. +non-nil, create a link to groups.google.com. Otherwise create a link to the article inside Gnus. If `org-store-link' was called with a prefix arg the meaning of @@ -118,9 +116,7 @@ If `org-store-link' was called with a prefix arg the meaning of (if (and (org-xor current-prefix-arg org-gnus-prefer-web-links) newsgroups ;make web links only for nntp groups (not x-no-archive)) ;and if X-No-Archive isn't set - (format (if (string-match-p "gmane\\." newsgroups) - "http://mid.gmane.org/%s" - "http://groups.google.com/groups/search?as_umsgid=%s") + (format "https://groups.google.com/groups/search?as_umsgid=%s" (url-encode-url message-id)) (concat "gnus:" group "#" message-id))) @@ -140,9 +136,15 @@ If `org-store-link' was called with a prefix arg the meaning of (`(nnvirtual . ,_) (save-excursion (car (nnvirtual-map-article (gnus-summary-article-number))))) - (`(nnir . ,_) + (`(,(or `nnselect `nnir) . ,_) ; nnir is for Emacs < 28. (save-excursion - (nnir-article-group (gnus-summary-article-number)))) + (cond + ((fboundp 'nnselect-article-group) + (nnselect-article-group (gnus-summary-article-number))) + ((fboundp 'nnir-article-group) + (nnir-article-group (gnus-summary-article-number))) + (t + (error "No article-group variant bound"))))) (_ gnus-newsgroup-name))) (header (if (eq major-mode 'gnus-article-mode) ;; When in an article, first move to summary @@ -215,7 +217,7 @@ If `org-store-link' was called with a prefix arg the meaning of (format "nntp+%s:%s" (or (cdr server) (car server)) group) article))) -(defun org-gnus-open (path) +(defun org-gnus-open (path _) "Follow the Gnus message or folder link specified by PATH." (unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path) (error "Error in Gnus link %S" path)) diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el index 58d45a7f7ee..864fbc47de3 100644 --- a/lisp/org/ol-info.el +++ b/lisp/org/ol-info.el @@ -59,7 +59,7 @@ :link link :desc desc) link))) -(defun org-info-open (path) +(defun org-info-open (path _) "Follow an Info file and node link specified by PATH." (org-info-follow-link path)) diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el index 3a347791eec..a2f8086b313 100644 --- a/lisp/org/ol-irc.el +++ b/lisp/org/ol-irc.el @@ -78,7 +78,7 @@ :store #'org-irc-store-link :export #'org-irc-export) -(defun org-irc-visit (link) +(defun org-irc-visit (link _) "Parse LINK and dispatch to the correct function based on the client found." (let ((link (org-irc-parse-link link))) (cond diff --git a/lisp/org/ol-mhe.el b/lisp/org/ol-mhe.el index 099882db1c5..50002b0e872 100644 --- a/lisp/org/ol-mhe.el +++ b/lisp/org/ol-mhe.el @@ -96,7 +96,7 @@ supported by MH-E." (org-link-add-props :link link :description desc) link)))) -(defun org-mhe-open (path) +(defun org-mhe-open (path _) "Follow an MH-E message link specified by PATH." (let (folder article) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) diff --git a/lisp/org/ol-rmail.el b/lisp/org/ol-rmail.el index cad8eaa169a..e43fc932ee2 100644 --- a/lisp/org/ol-rmail.el +++ b/lisp/org/ol-rmail.el @@ -43,7 +43,9 @@ (defvar rmail-file-name) ; From rmail.el ;; Install the link type -(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link) +(org-link-set-parameters "rmail" + :follow #'org-rmail-open + :store #'org-rmail-store-link) ;; Implementation (defun org-rmail-store-link () @@ -75,7 +77,7 @@ (rmail-show-message rmail-current-message) link))))) -(defun org-rmail-open (path) +(defun org-rmail-open (path _) "Follow an Rmail message link to the specified PATH." (let (folder article) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) diff --git a/lisp/org/ol.el b/lisp/org/ol.el index baed23bc9a4..77ca21e2643 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -45,6 +45,7 @@ (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) (declare-function org-at-heading-p "org" (&optional _)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-before-first-heading-p "org" ()) (declare-function org-do-occur "org" (regexp &optional cleanup)) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-cache-refresh "org-element" (pos)) @@ -57,7 +58,6 @@ (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-find-property "org" (property &optional value)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) -(declare-function org-heading-components "org" ()) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-id-store-link "org-id" ()) (declare-function org-insert-heading "org" (&optional arg invisible-ok top)) @@ -85,42 +85,94 @@ :group 'org) (defcustom org-link-parameters nil - "An alist of properties that defines all the links in Org mode. + "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 plist of link properties. +Subsequent optional elements make up a property list for that +type. -:follow - A function that takes the link path as an argument. +All properties are optional. However, the most important ones +are, in this order, `:follow', `:export', and `:store', described +below. -:export - A function that takes the link path, description and -export-backend as arguments. +`:follow' -:store - A function responsible for storing the link. See the -function `org-store-link-functions'. + Function used to follow the link, when the `org-open-at-point' + command runs on it. It is called with two arguments: the path, + as a string, and a universal prefix argument. -:complete - A function that inserts a link with completion. The -function takes one optional prefix argument. + Here, you may use `org-link-open-as-file' helper function for + types similar to \"file\". -: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'. +`:export' -:mouse-face - The mouse-face. The default is `highlight'. + Function that accepts four arguments: + - the path, as a string, + - the description as a string, or nil, + - the export back-end, + - the export communication channel, as a plist. -:display - `full' will not fold the link in descriptive -display. Default is `org-link'. + When nil, export for that type of link is delegated to the + back-end. -:help-echo - A string or function that takes (window object position) -as arguments and returns a string. +`:store' -:keymap - A keymap that is active on the link. The default is -`org-mouse-map'. + Function responsible for storing the link. See the function + `org-store-link-functions' for a description of the expected + arguments. -:htmlize-link - A function for the htmlize-link. Defaults -to (list :uri \"type:path\") +Additional properties provide more specific control over the +link. -: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." +`:activate-func' + + Function to run at the end of Font Lock activation. It must + accept four arguments: + - the buffer position at the start of the link, + - the buffer position at its end, + - the path, as a string, + - a boolean, non-nil when the link has brackets. + +`:complete' + + Function that inserts a link with completion. The function + takes one optional prefix argument. + +`:display' + + Value for `invisible' text property on the hidden parts of the + link. The most useful value is `full', which will not fold the + link in descriptive display. Default is `org-link'. + +`:face' + + Face for the link, or a function returning a face. The + function takes one argument, which is the path. + + The default face is `org-link'. + +`:help-echo' + + String or function used as a value for the `help-echo' text + property. The function is called with one argument, the help + string to display, and should return a string. + +`:htmlize-link' + + Function or plist for the `htmlize-link' text property. The + function takes no argument. + + Default is (:uri \"type:path\") + +`:keymap' + + Active keymap when point is on the link. Default is + `org-mouse-map'. + +`:mouse-face' + + Face used when hovering over the link. Default is + `highlight'." :group 'org-link :package-version '(Org . "9.1") :type '(alist :tag "Link display parameters" @@ -408,7 +460,7 @@ This is for example useful to limit the length of the subject. Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" :group 'org-link-store - :package-version '(Org . 9.3) + :package-version '(Org . "9.3") :type 'string :safe #'stringp) @@ -674,6 +726,44 @@ White spaces are not significant." (goto-char origin) (user-error "No match for radio target: %s" target)))) +(defun org-link--context-from-region () + "Return context string from active region, or nil." + (when (org-region-active-p) + (let ((context (buffer-substring (region-beginning) (region-end)))) + (when (and (wholenump org-link-context-for-files) + (> org-link-context-for-files 0)) + (let ((lines (org-split-string context "\n"))) + (setq context + (mapconcat #'identity + (cl-subseq lines 0 org-link-context-for-files) + "\n")))) + context))) + +(defun org-link--normalize-string (string &optional context) + "Remove ignored contents from STRING string and return it. +This function removes contiguous white spaces and statistics +cookies. When optional argument CONTEXT is non-nil, it assumes +STRING is a context string, and also removes special search +syntax around the string." + (let ((string + (org-trim + (replace-regexp-in-string + (rx (one-or-more (any " \t"))) + " " + (replace-regexp-in-string + ;; Statistics cookie regexp. + (rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]")) + " " + string))))) + (when context + (while (cond ((and (string-prefix-p "(" string) + (string-suffix-p ")" string)) + (setq string (org-trim (substring string 1 -1)))) + ((string-match "\\`[#*]+[ \t]*" string) + (setq string (substring string (match-end 0)))) + (t nil)))) + string)) + ;;; Public API @@ -692,6 +782,8 @@ TYPE is a string and KEY is a plist keyword. See "Set link TYPE properties to PARAMETERS. PARAMETERS should be keyword value pairs. See `org-link-parameters' for supported keys." + (when (member type '("coderef" "custom-id" "fuzzy" "radio")) + (error "Cannot override reserved link type: %S" type)) (let ((data (assoc type org-link-parameters))) (if data (setcdr data (org-combine-plists (cdr data) parameters)) (push (cons type parameters) org-link-parameters) @@ -716,12 +808,10 @@ This should be called after the variable `org-link-parameters' has changed." (rx (seq "[[" ;; URI part: match group 1. (group - ;; Allow an even number of backslashes right - ;; before the closing bracket. - (or (one-or-more "\\\\") - (and (*? anything) - (not (any "\\")) - (zero-or-more "\\\\")))) + (one-or-more + (or (not (any "[]\\")) + (and "\\" (zero-or-more "\\\\") (any "[]")) + (and (one-or-more "\\") (not (any "[]")))))) "]" ;; Description (optional): match group 2. (opt "[" (group (+? anything)) "]") @@ -838,37 +928,26 @@ E.g. \"%C3%B6\" becomes the german o-Umlaut." (defun org-link-escape (link) "Backslash-escape sensitive characters in string LINK." - ;; Escape closing square brackets followed by another square bracket - ;; or at the end of the link. Also escape final backslashes so that - ;; we do not escape inadvertently URI's closing bracket. - (with-temp-buffer - (insert link) - (insert (make-string (- (skip-chars-backward "\\\\")) - ?\\)) - (while (search-backward "\]" nil t) - (when (looking-at-p "\\]\\(?:[][]\\|\\'\\)") - (insert (make-string (1+ (- (skip-chars-backward "\\\\"))) - ?\\)))) - (buffer-string))) + (replace-regexp-in-string + (rx (seq (group (zero-or-more "\\")) (group (or string-end (any "[]"))))) + (lambda (m) + (concat (match-string 1 m) + (match-string 1 m) + (and (/= (match-beginning 2) (match-end 2)) "\\"))) + link nil t 1)) (defun org-link-unescape (link) "Remove escaping backslash characters from string LINK." - (with-temp-buffer - (save-excursion (insert link)) - (while (re-search-forward "\\(\\\\+\\)\\]\\(?:[][]\\|\\'\\)" nil t) - (replace-match (make-string (/ (- (match-end 1) (match-beginning 1)) 2) - ?\\) - nil t nil 1)) - (goto-char (point-max)) - (delete-char (/ (- (skip-chars-backward "\\\\")) 2)) - (buffer-string))) + (replace-regexp-in-string + (rx (group (one-or-more "\\")) (or string-end (any "[]"))) + (lambda (_) + (concat (make-string (/ (- (match-end 1) (match-beginning 1)) 2) ?\\))) + link nil t 1)) (defun org-link-make-string (link &optional description) "Make a bracket link, consisting of LINK and DESCRIPTION. LINK is escaped with backslashes for inclusion in buffer." - (unless (org-string-nw-p link) (error "Empty link")) - (let* ((uri (org-link-escape link)) - (zero-width-space (string ?\x200B)) + (let* ((zero-width-space (string ?\x200B)) (description (and (org-string-nw-p description) ;; Description cannot contain two consecutive square @@ -881,9 +960,10 @@ LINK is escaped with backslashes for inclusion in buffer." (replace-regexp-in-string "]\\'" (concat "\\&" zero-width-space) (org-trim description)))))) - (format "[[%s]%s]" - uri - (if description (format "[%s]" description) "")))) + (if (not (org-string-nw-p link)) description + (format "[[%s]%s]" + (org-link-escape link) + (if description (format "[%s]" description) ""))))) (defun org-store-link-functions () "List of functions that are called to create and store a link. @@ -930,7 +1010,8 @@ Abbreviations are defined in `org-link-abbrev-alist'." ((string-match "%(\\([^)]+\\))" rpl) (replace-match (save-match-data - (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) + (funcall (intern-soft (match-string 1 rpl)) tag)) + t t rpl)) ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) ((string-match "%h" rpl) (replace-match (url-hexify-string (or tag "")) t t rpl)) @@ -938,63 +1019,60 @@ Abbreviations are defined in `org-link-abbrev-alist'." (defun org-link-open (link &optional arg) "Open a link object LINK. -Optional argument is passed to `org-open-file' when S is -a \"file\" link." + +ARG is an optional prefix argument. Some link types may handle +it. For example, it determines what application to run when +opening a \"file\" link. + +Functions responsible for opening the link are either hard-coded +for internal and \"file\" links, or stored as a parameter in +`org-link-parameters', which see." (let ((type (org-element-property :type link)) (path (org-element-property :path link))) - (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 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-link--buffer-for-internals))) - (let ((destination - (org-with-wide-buffer - (if (equal type "radio") - (org-link--search-radio-target - (org-element-property :path link)) - (org-link-search - (pcase type - ("custom-id" (concat "#" path)) - ("coderef" (format "(%s)" path)) - (_ 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))))) + (pcase type + ;; Opening a "file" link requires special treatment since we + ;; first need to integrate search option, if any. + ("file" + (let* ((option (org-element-property :search-option link)) + (path (if option (concat path "::" option) path))) + (org-link-open-as-file path + (pcase (org-element-property :application link) + ((guard arg) arg) + ("emacs" 'emacs) + ("sys" 'system))))) + ;; Internal links. + ((or "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-link--buffer-for-internals))) + (let ((destination + (org-with-wide-buffer + (if (equal type "radio") + (org-link--search-radio-target path) + (org-link-search + (pcase type + ("custom-id" (concat "#" path)) + ("coderef" (format "(%s)" path)) + (_ 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)))) + (_ + ;; Look for a dedicated "follow" function in custom links. + (let ((f (org-link-get-parameter type :follow))) + (when (functionp f) + ;; Function defined in `:follow' parameter may use a single + ;; argument, as it was mandatory before Org 9.4. This is + ;; deprecated, but support it for now. + (condition-case nil + (funcall (org-link-get-parameter type :follow) path arg) + (wrong-number-of-arguments + (funcall (org-link-get-parameter type :follow) path))))))))) (defun org-link-open-from-string (s &optional arg) "Open a link in the string S, as if it was in Org mode. @@ -1095,10 +1173,9 @@ of matched result, which is either `dedicated' or `fuzzy'." (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))) + (let* ((element (org-element-at-point)) + (name (org-element-property :name element))) + (when (and name (equal words (split-string name))) (setq type 'dedicated) (beginning-of-line) (throw :name-match t)))) @@ -1111,18 +1188,14 @@ of matched result, which is either `dedicated' or `fuzzy'." (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))) + (mapconcat #'regexp-quote words ".+")))) (goto-char (point-min)) (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 t))))) + (org-link--normalize-string + (org-get-heading t t t t)))) (throw :found t))) nil))) (beginning-of-line) @@ -1173,24 +1246,40 @@ of matched result, which is either `dedicated' or `fuzzy'." type)) (defun org-link-heading-search-string (&optional string) - "Make search string for the current headline or STRING." - (let ((s (or string - (and (derived-mode-p 'org-mode) - (save-excursion - (org-back-to-heading t) - (org-element-property :raw-value - (org-element-at-point)))))) - (lines org-link-context-for-files)) - (unless string (setq s (concat "*" s))) ;Add * for headlines - (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) - (when (and string (integerp lines) (> lines 0)) - (let ((slines (org-split-string s "\n"))) - (when (< lines (length slines)) - (setq s (mapconcat - #'identity - (reverse (nthcdr (- (length slines) lines) - (reverse slines))) "\n"))))) - (mapconcat #'identity (split-string s) " "))) + "Make search string for the current headline or STRING. + +Search string starts with an asterisk. COMMENT keyword and +statistics cookies are removed, and contiguous spaces are packed +into a single one. + +When optional argument STRING is non-nil, assume it a headline, +without any asterisk, TODO or COMMENT keyword, and without any +priority cookie or tag." + (concat "*" + (org-link--normalize-string + (or string (org-get-heading t t t t))))) + +(defun org-link-open-as-file (path arg) + "Pretend PATH is a file name and open it. + +According to \"file\"-link syntax, PATH may include additional +search options, separated from the file name with \"::\". + +This function is meant to be used as a possible tool for +`:follow' property in `org-link-parameters'." + (let* ((option (and (string-match "::\\(.*\\)\\'" path) + (match-string 1 path))) + (file-name (if (not option) path + (substring path 0 (match-beginning 0))))) + (if (string-match "[*?{]" (file-name-nondirectory file-name)) + (dired file-name) + (apply #'org-open-file + file-name + arg + (cond ((not option) nil) + ((string-match-p "\\`[0-9]+\\'" option) + (list (string-to-number option))) + (t (list nil option))))))) (defun org-link-display-format (s) "Replace links in string S with their description. @@ -1211,15 +1300,15 @@ If there is no description, use the link target." ;;; Built-in link types ;;;; "doi" link type -(defun org-link--open-doi (path) +(defun org-link--open-doi (path arg) "Open a \"doi\" type link. PATH is a the path to search for, as a string." - (browse-url (url-encode-url (concat org-link-doi-server-url path)))) + (browse-url (url-encode-url (concat org-link-doi-server-url path)) arg)) (org-link-set-parameters "doi" :follow #'org-link--open-doi) ;;;; "elisp" link type -(defun org-link--open-elisp (path) +(defun org-link--open-elisp (path _) "Open a \"elisp\" type link. PATH is the sexp to evaluate, as a string." (if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp) @@ -1240,7 +1329,7 @@ PATH is the sexp to evaluate, as a string." (org-link-set-parameters "file" :complete #'org-link-complete-file) ;;;; "help" link type -(defun org-link--open-help (path) +(defun org-link--open-help (path _) "Open a \"help\" type link. PATH is a symbol name, as a string." (pcase (intern path) @@ -1254,10 +1343,11 @@ PATH is a symbol name, as a string." (dolist (scheme '("ftp" "http" "https" "mailto" "news")) (org-link-set-parameters scheme :follow - (lambda (url) (browse-url (concat scheme ":" url))))) + (lambda (url arg) + (browse-url (concat scheme ":" url) arg)))) ;;;; "shell" link type -(defun org-link--open-shell (path) +(defun org-link--open-shell (path _) "Open a \"shell\" type link. PATH is the command to execute, as a string." (if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp) @@ -1375,7 +1465,7 @@ non-nil." (move-beginning-of-line 2) (set-mark (point))))) (setq org-store-link-plist nil) - (let (link cpltxt desc description search txt custom-id agenda-link) + (let (link cpltxt desc description search custom-id agenda-link) (cond ;; Store a link using an external link type, if any function is ;; available. If more than one can generate a link from current @@ -1465,10 +1555,16 @@ non-nil." (org-link-store-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)))) + (let ((symbol (replace-regexp-in-string + ;; Help mode escapes backquotes and backslashes + ;; before displaying them. E.g., "`" appears + ;; as "\'" for reasons. Work around this. + (rx "\\" (group (or "`" "\\"))) "\\1" + (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0))))) + (setq link (concat "help:" symbol))) (org-link-store-props :type "help")) ((eq major-mode 'w3-mode) @@ -1534,30 +1630,35 @@ non-nil." (abbreviate-file-name (buffer-file-name (buffer-base-buffer)))))))) (t - ;; Just link to current headline + ;; Just link to current headline. (setq cpltxt (concat "file:" (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string + ;; Add a context search string. (when (org-xor org-link-context-for-files (equal arg '(4))) (let* ((element (org-element-at-point)) - (name (org-element-property :name element))) - (setq txt (cond - ((org-at-heading-p) nil) - (name) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" - (condition-case nil - (org-link-heading-search-string txt) - (error ""))) - desc (or name - (nth 4 (ignore-errors (org-heading-components))) - "NONE"))))) - (when (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) + (name (org-element-property :name element)) + (context + (cond + ((let ((region (org-link--context-from-region))) + (and region (org-link--normalize-string region t)))) + (name) + ((org-before-first-heading-p) + (org-link--normalize-string (org-current-line-string) t)) + (t (org-link-heading-search-string))))) + (when (org-string-nw-p context) + (setq cpltxt (format "%s::%s" cpltxt context)) + (setq desc + (or name + ;; Although description is not a search + ;; string, use `org-link--normalize-string' + ;; to prettify it (contiguous white spaces) + ;; and remove volatile contents (statistics + ;; cookies). + (and (not (org-before-first-heading-p)) + (org-link--normalize-string + (org-get-heading t t t t))) + "NONE"))))) (setq link cpltxt))))) ((buffer-file-name (buffer-base-buffer)) @@ -1565,16 +1666,16 @@ non-nil." (setq cpltxt (concat "file:" (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string. + ;; Add a context search string. (when (org-xor org-link-context-for-files (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-link-heading-search-string txt)) - desc "NONE"))) + (let ((context (org-link--normalize-string + (or (org-link--context-from-region) + (org-current-line-string)) + t))) + ;; Only use search option if there is some text. + (when (org-string-nw-p context) + (setq cpltxt (format "%s::%s" cpltxt context)) + (setq desc "NONE")))) (setq link cpltxt)) (interactive? @@ -1589,15 +1690,19 @@ non-nil." (cond ((not desc)) ((equal desc "NONE") (setq desc nil)) (t (setq desc (org-link-display-format desc)))) - ;; Return the link + ;; Store and return the link (if (not (and interactive? link)) (or agenda-link (and link (org-link-make-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)) + (if (member (list link desc) org-stored-links) + (message "This link already exists") + (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 (buffer-base-buffer))) + "::#" custom-id)) + (push (list link desc) org-stored-links))) (car org-stored-links))))) ;;;###autoload @@ -1737,13 +1842,14 @@ Use TAB to complete link prefixes, then RET for type-specific completion support ;; 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 + (when (and (buffer-file-name (buffer-base-buffer)) (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 - (when (equal (file-truename buffer-file-name) (file-truename path)) + (when (equal (file-truename (buffer-file-name (buffer-base-buffer))) + (file-truename path)) ;; We are linking to this same file, with a search option (setq link search))))) @@ -1903,7 +2009,10 @@ Also refresh fontification if needed." (org-link-make-regexps) - (provide 'ol) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; ol.el ends here diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 4f89ea54500..83f30bf96af 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -49,6 +49,7 @@ (require 'ol) (require 'org) (require 'org-macs) +(require 'org-refile) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -83,6 +84,7 @@ (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)) +(declare-function org-clock-modify-effort-estimate "org-clock" (&optional value)) (defvar calendar-mode-map) (defvar org-clock-current-task) @@ -185,7 +187,7 @@ and `org-agenda-entry-text-maxlines'." "Non-nil means export org-links as descriptive links in agenda added text. This variable applies to the text added to the agenda when `org-agenda-add-entry-text-maxlines' is larger than 0. -When this variable nil, the URL will (also) be shown." +When this variable is nil, the URL will (also) be shown." :group 'org-agenda :type 'boolean) @@ -1012,6 +1014,12 @@ headlines as the agenda display heavily relies on them." :group 'org-agenda-startup :type 'hook) +(defcustom org-agenda-filter-hook nil + "Hook run just after filtering with `org-agenda-filter'." + :group 'org-agenda-startup + :package-version '(Org . "9.4") + :type 'hook) + (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. Needs to be set @@ -1092,14 +1100,21 @@ 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. Also, when exiting the agenda, kill that frame. +other-tab Use `switch-to-buffer-other-tab' to display the + agenda, making use of the `tab-bar-mode' introduced + in Emacs version 27.1. Also, kill that tab when + exiting the agenda view. + See also the variable `org-agenda-restore-windows-after-quit'." :group 'org-agenda-windows :type '(choice (const current-window) (const other-frame) + (const other-tab) (const other-window) (const only-window) - (const reorganize-frame))) + (const reorganize-frame)) + :package-version '(Org . "9.4")) (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) "The min and max height of the agenda window as a fraction of frame height. @@ -1110,11 +1125,11 @@ It only matters if `org-agenda-window-setup' is `reorganize-frame'." (defcustom org-agenda-restore-windows-after-quit nil "Non-nil means restore window configuration upon exiting agenda. -Before the window configuration is changed for displaying the agenda, -the current status is recorded. When the agenda is exited with -`q' or `x' and this option is set, the old state is restored. If -`org-agenda-window-setup' is `other-frame', the value of this -option will be ignored." +Before the window configuration is changed for displaying the +agenda, the current status is recorded. When the agenda is +exited with `q' or `x' and this option is set, the old state is +restored. If `org-agenda-window-setup' is `other-frame' or +`other-tab', the value of this option will be ignored." :group 'org-agenda-windows :type 'boolean) @@ -1156,6 +1171,11 @@ argument, a calendar-style date list like (month day year)." (string :tag "Format string") (function :tag "Function"))) +(defun org-agenda-end-of-line () + "Go to the end of visible line." + (interactive) + (goto-char (line-end-position))) + (defun org-agenda-format-date-aligned (date) "Format a DATE string for display in the daily/weekly agenda. This function makes sure that dates are aligned for easy reading." @@ -1238,6 +1258,16 @@ in the past." :version "24.1" :type 'boolean) +(defcustom org-agenda-diary-file 'diary-file + "File to which to add new entries with the `i' key in agenda and calendar. +When this is the symbol `diary-file', the functionality in the Emacs +calendar will be used to add entries to the `diary-file'. But when this +points to a file, `org-agenda-diary-entry' will be used instead." + :group 'org-agenda + :type '(choice + (const :tag "The standard Emacs diary file" diary-file) + (file :tag "Special Org file diary entries"))) + (defcustom org-agenda-include-diary nil "If non-nil, include in the agenda entries from the Emacs Calendar's diary. Custom commands can set this variable in the options section." @@ -1619,7 +1649,7 @@ part of an agenda sorting strategy." :group 'org-agenda-sorting :type 'symbol) -(defcustom org-sort-agenda-notime-is-late t +(defcustom org-agenda-sort-notime-is-late t "Non-nil means items without time are considered late. This is only relevant for sorting. When t, items which have no explicit time like 15:30 will be considered as 99:01, i.e. later than any items which @@ -1629,7 +1659,7 @@ agenda entries." :group 'org-agenda-sorting :type 'boolean) -(defcustom org-sort-agenda-noeffort-is-high t +(defcustom org-agenda-sort-noeffort-is-high t "Non-nil means items without effort estimate are sorted as high effort. This also applies when filtering an agenda view with respect to the < or > effort operator. Then, tasks with no effort defined will be treated @@ -1883,7 +1913,7 @@ Nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice (const :tag "Hide none" nil) - (string :tag "Regexp "))) + (regexp :tag "Regexp "))) (defvaralias 'org-agenda-remove-tags-when-in-prefix 'org-agenda-remove-tags) @@ -1923,8 +1953,8 @@ However, settings in `org-priority-faces' will overrule these faces. When this variable is the symbol `cookies', only fontify the cookies, not the entire task. This may also be an association list of priority faces, whose -keys are the character values of `org-highest-priority', -`org-default-priority', and `org-lowest-priority' (the default values +keys are the character values of `org-priority-highest', +`org-priority-default', and `org-priority-lowest' (the default values are ?A, ?B, and ?C, respectively). The face may be a named face, a color as a string, or a list like `(:background \"Red\")'. If it is a color, the variable `org-faces-easy-properties' @@ -1980,12 +2010,12 @@ category, you can use: (\"Emacs\" \\='(space . (:width (16))))" :group 'org-agenda-line-format :version "24.1" - :type '(alist :key-type (string :tag "Regexp matching category") + :type '(alist :key-type (regexp :tag "Regexp matching category") :value-type (choice (list :tag "Icon" (string :tag "File or data") (symbol :tag "Type") (boolean :tag "Data?") - (repeat :tag "Extra image properties" :inline t symbol)) + (repeat :tag "Extra image properties" :inline t sexp)) (list :tag "Display properties" sexp)))) (defgroup org-agenda-column-view nil @@ -2101,6 +2131,8 @@ evaluate to a string." (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") +(org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line) + (defvar org-agenda-menu) ; defined later in this file. (defvar org-agenda-restrict nil) ; defined later in this file. (defvar org-agenda-follow-mode nil) @@ -2197,6 +2229,7 @@ The following commands are available: \\{org-agenda-mode-map}" (interactive) + (ignore-errors (require 'face-remap)) (let ((agenda-local-vars-to-keep '(text-scale-mode-amount text-scale-mode @@ -2209,8 +2242,8 @@ The following commands are available: (dolist (elem save) (pcase elem (`(,var . ,val) ;ignore unbound variables - (when (and val (memq var var-set)) - (set var val))))))) + (when (and val (memq var var-set)) + (set var val))))))) (cond (org-agenda-doing-sticky-redo ;; Refreshing sticky agenda-buffer ;; @@ -2236,7 +2269,6 @@ The following commands are available: (setq mode-name "Org-Agenda") (setq indent-tabs-mode nil) (use-local-map org-agenda-mode-map) - (easy-menu-add org-agenda-menu) (when org-startup-truncated (setq truncate-lines t)) (setq-local line-move-visual nil) (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) @@ -2274,155 +2306,152 @@ The following commands are available: (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) (list 'org-agenda-mode-hook))) -(substitute-key-definition 'undo 'org-agenda-undo +(substitute-key-definition #'undo #'org-agenda-undo org-agenda-mode-map global-map) -(org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto) -(org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) -(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) -(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) -(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) -(org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward) -(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward) -(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) -(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle) -(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all) -(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all) -(org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks) -(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) -(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) -(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all) -(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) -(org-defkey org-agenda-mode-map "k" 'org-agenda-capture) -(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) -(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default) -(org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag) -(org-defkey org-agenda-mode-map "\C-c\C-xA" 'org-agenda-archive-to-archive-sibling) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "$" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) -(org-defkey org-agenda-mode-map " " 'org-agenda-show-and-scroll-up) -(org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down) -(org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down) -(org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) -(org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) -(org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) -(org-defkey org-agenda-mode-map "o" 'delete-other-windows) -(org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) -(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) -(org-defkey org-agenda-mode-map "t" 'org-agenda-todo) -(org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation) -(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) -(org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags) -(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) -(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) -(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) -(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) -(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) -(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) -(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) -(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) -(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier) - -(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) -(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) -(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) +(org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto) +(org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto) +(org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to) +(org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill) +(org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile) +(org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward) +(org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward) +(org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle) +(org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all) +(org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all) +(org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks) +(org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp) +(org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark) +(org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all) +(org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action) +(org-defkey org-agenda-mode-map "k" #'org-agenda-capture) +(org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda) +(org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default) +(org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag) +(org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive) +(org-defkey org-agenda-mode-map "$" #'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link) +(org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up) +(org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down) +(org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down) +(org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset) +(org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset) +(org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer) +(org-defkey org-agenda-mode-map "o" #'delete-other-windows) +(org-defkey org-agenda-mode-map "L" #'org-agenda-recenter) +(org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo) +(org-defkey org-agenda-mode-map "t" #'org-agenda-todo) +(org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation) +(org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags) +(org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags) +(org-defkey org-agenda-mode-map "." #'org-agenda-goto-today) +(org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date) +(org-defkey org-agenda-mode-map "d" #'org-agenda-day-view) +(org-defkey org-agenda-mode-map "w" #'org-agenda-week-view) +(org-defkey org-agenda-mode-map "y" #'org-agenda-year-view) +(org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note) +(org-defkey org-agenda-mode-map "z" #'org-agenda-add-note) +(org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier) +(org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt) +(org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule) +(org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline) (let ((l '(1 2 3 4 5 6 7 8 9 0))) (while l (org-defkey org-agenda-mode-map - (int-to-string (pop l)) 'digit-argument))) - -(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode) -(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) -(org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode) -(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) -(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) -(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) -(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) -(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) -(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) -(org-defkey org-agenda-mode-map "g" 'org-agenda-redo-all) -(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort) -(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) + (number-to-string (pop l)) #'digit-argument))) +(org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode) +(org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode) +(org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode) +(org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode) +(org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch) +(org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary) +(org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines) +(org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid) +(org-defkey org-agenda-mode-map "r" #'org-agenda-redo) +(org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all) +(org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort) (org-defkey org-agenda-mode-map "\C-c\C-x\C-e" - 'org-clock-modify-effort-estimate) -(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) -(org-defkey org-agenda-mode-map "q" 'org-agenda-quit) -(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit) -(org-defkey org-agenda-mode-map "x" 'org-agenda-exit) -(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) -(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) -(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) -(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) -(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line) -(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line) -(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item) -(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item) -(substitute-key-definition 'next-line 'org-agenda-next-line + #'org-clock-modify-effort-estimate) +(org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property) +(org-defkey org-agenda-mode-map "q" #'org-agenda-quit) +(org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit) +(org-defkey org-agenda-mode-map "x" #'org-agenda-exit) +(org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write) +(org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers) +(org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers) +(org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags) +(org-defkey org-agenda-mode-map "n" #'org-agenda-next-line) +(org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line) +(org-defkey org-agenda-mode-map "N" #'org-agenda-next-item) +(org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item) +(substitute-key-definition #'next-line #'org-agenda-next-line org-agenda-mode-map global-map) -(substitute-key-definition 'previous-line 'org-agenda-previous-line +(substitute-key-definition #'previous-line #'org-agenda-previous-line org-agenda-mode-map global-map) -(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach) -(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) -(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) -(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) -(org-defkey org-agenda-mode-map "," 'org-agenda-priority) -(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) -(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) -(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) -(org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) -(org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) -(org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) -(org-defkey org-agenda-mode-map "H" 'org-agenda-holidays) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in) -(org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out) -(org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) -(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto) -(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) -(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) -(org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map "f" 'org-agenda-later) -(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) -(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) -(org-defkey org-agenda-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock-from-agenda) - -(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) -(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) -(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) -(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) -(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) -(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) -(org-defkey org-agenda-mode-map "\C-c\C-x_" 'org-timer-stop) -(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) -(org-defkey org-agenda-mode-map "\C-c\C-xI" 'org-info-find-node) - -(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) +(org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach) +(org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line) +(org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line) +(org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority) +(org-defkey org-agenda-mode-map "," #'org-agenda-priority) +(org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry) +(org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar) +(org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date) +(org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon) +(org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset) +(org-defkey org-agenda-mode-map "h" #'org-agenda-holidays) +(org-defkey org-agenda-mode-map "H" #'org-agenda-holidays) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in) +(org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out) +(org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel) +(org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto) +(org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto) +(org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up) +(org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down) +(org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up) +(org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down) +(org-defkey org-agenda-mode-map "f" #'org-agenda-later) +(org-defkey org-agenda-mode-map "b" #'org-agenda-earlier) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns) +(org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock) +(org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda) +(org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add) +(org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract) +(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) +(org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all) +(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) +(org-defkey org-agenda-mode-map ";" #'org-timer-set-timer) +(org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop) +(org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push) +(org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node) +(org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse) +(org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse) +(org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block) +(org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block) +(org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c) (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" '("Agenda" ("Agenda Files") @@ -2563,7 +2592,7 @@ The following commands are available: ["Set Priority" org-agenda-priority t] ["Increase Priority" org-agenda-priority-up t] ["Decrease Priority" org-agenda-priority-down t] - ["Show Priority" org-show-priority t]) + ["Show Priority" org-priority-show t]) ("Calendar/Diary" ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)] ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)] @@ -2995,7 +3024,8 @@ Agenda views are separated by `org-agenda-block-separator'." (erase-buffer) (insert (eval-when-compile (let ((header - "Press key for an agenda command: + (copy-sequence + "Press key for an agenda command: -------------------------------- < Buffer, subtree/region restriction a Agenda for current week or day > Remove restriction t List of all TODO entries e Export agenda views @@ -3004,7 +3034,7 @@ s Search for keywords M Like m, but only TODO entries / Multi-occur S Like s, but only TODO entries ? Find :FLAGGED: entries C Configure custom agenda commands * Toggle sticky agenda views # List stuck projects (!=configure) -") +")) (start 0)) (while (string-match "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" @@ -3112,7 +3142,7 @@ s Search for keywords M Like m, but only TODO entries ;; Hint to navigation if window too small for all information (setq header-line-format (when (not (pos-visible-in-window-p (point-max))) - "Use SPC, DEL, C-n or C-p to navigate.")) + "Use C-v, M-v, C-n or C-p to navigate.")) ;; Ask for selection (cl-loop @@ -3126,24 +3156,8 @@ s Search for keywords M Like m, but only TODO entries " (unrestricted)")) "")) (setq c (read-char-exclusive))) - until (not (memq c '(14 16 ?\s ?\d))) - do (cl-case c - (14 (if (not (pos-visible-in-window-p (point-max))) - (ignore-errors (scroll-up 1)) - (message "End of buffer") - (sit-for 1))) - (16 (if (not (pos-visible-in-window-p (point-min))) - (ignore-errors (scroll-down 1)) - (message "Beginning of buffer") - (sit-for 1))) - (?\s (if (not (pos-visible-in-window-p (point-max))) - (scroll-up nil) - (message "End of buffer") - (sit-for 1))) - (?\d (if (not (pos-visible-in-window-p (point-min))) - (scroll-down nil) - (message "Beginning of buffer") - (sit-for 1))))) + until (not (memq c '(14 16 22 134217846))) + do (org-scroll c)) (message "") (cond @@ -3590,8 +3604,7 @@ removed from the entry content. Currently only `planning' is allowed here." (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 (match-end 0)))) (goto-char (point-min)) (while (re-search-forward org-link-bracket-re (point-max) t) (set-text-properties (match-beginning 0) (match-end 0) @@ -3746,6 +3759,14 @@ generating a new one." ;; does not have org variables local org-agenda-this-buffer-is-sticky)))) +(defvar org-agenda-buffer-tmp-name nil) + +(defun org-agenda--get-buffer-name (sticky-name) + (or org-agenda-buffer-tmp-name + (and org-agenda-doing-sticky-redo org-agenda-buffer-name) + sticky-name + "*Org Agenda*")) + (defun org-agenda-prepare-window (abuf filter-alist) "Setup agenda buffer in the window. ABUF is the buffer for the agenda window. @@ -3762,6 +3783,10 @@ FILTER-ALIST is an alist of filters we need to apply when (org-switch-to-buffer-other-window abuf)) ((eq org-agenda-window-setup 'other-frame) (switch-to-buffer-other-frame abuf)) + ((eq org-agenda-window-setup 'other-tab) + (if (fboundp 'switch-to-buffer-other-tab) + (switch-to-buffer-other-tab abuf) + (user-error "Your version of Emacs does not have tab bar support"))) ((eq org-agenda-window-setup 'only-window) (delete-other-windows) (pop-to-buffer-same-window abuf)) @@ -3846,15 +3871,17 @@ FILTER-ALIST is an alist of filters we need to apply when (defvar org-overriding-columns-format) (defvar org-local-columns-format) (defun org-agenda-finalize () - "Finishing touch for the agenda buffer, called just before displaying it." + "Finishing touch for the agenda buffer. +This function is called just before displaying the agenda. If +you want to add your own functions to the finalization of the +agenda display, configure `org-agenda-finalize-hook'." (unless org-agenda-multi - (save-excursion - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t)) + (save-excursion (goto-char (point-min)) (save-excursion (while (org-activate-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) + (goto-char (match-end 0)))) (unless (eq org-agenda-remove-tags t) (org-agenda-align-tags)) (unless org-agenda-with-colors @@ -3893,7 +3920,6 @@ FILTER-ALIST is an alist of filters we need to apply when 'tags (org-with-point-at mrk (mapcar #'downcase (org-get-tags))))))))) - (run-hooks 'org-agenda-finalize-hook) (setq org-agenda-represented-tags nil org-agenda-represented-categories nil) (when org-agenda-top-headline-filter @@ -3919,12 +3945,13 @@ FILTER-ALIST is an alist of filters we need to apply when (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))))) + (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)) + (run-hooks 'org-agenda-finalize-hook)))) (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') + ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in'). (when (bound-and-true-p org-clock-current-task) (save-restriction (widen) @@ -3959,15 +3986,15 @@ FILTER-ALIST is an alist of filters we need to apply when (save-excursion (let (b e p ov h l) (goto-char (point-min)) - (while (re-search-forward "\\[#\\(.\\)\\]" nil t) - (setq h (or (get-char-property (point) 'org-highest-priority) - org-highest-priority) - l (or (get-char-property (point) 'org-lowest-priority) - org-lowest-priority) - p (string-to-char (match-string 1)) - b (match-beginning 0) + (while (re-search-forward org-priority-regexp nil t) + (setq h (or (get-char-property (point) 'org-priority-highest) + org-priority-highest) + l (or (get-char-property (point) 'org-priority-lowest) + org-priority-lowest) + p (string-to-char (match-string 2)) + b (match-beginning 1) e (if (eq org-agenda-fontify-priorities 'cookies) - (match-end 0) + (1+ (match-end 2)) (point-at-eol)) ov (make-overlay b e)) (overlay-put @@ -3995,7 +4022,7 @@ dimming them." (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...")) (dolist (o (overlays-in (point-min) (point-max))) - (when (eq (overlay-get o 'org-type) 'org-blocked-todo) + (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face) (delete-overlay o))) (save-excursion (let ((inhibit-read-only t)) @@ -4003,22 +4030,26 @@ dimming them." (while (let ((pos (text-property-not-all (point) (point-max) 'org-todo-blocked nil))) (when pos (goto-char pos))) - (let* ((invisible (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) + (let* ((invisible + (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) + (todo-blocked + (eq (org-get-at-bol 'org-filter-type) 'todo-blocked)) (ov (make-overlay (if invisible (line-end-position 0) (line-beginning-position)) (line-end-position)))) - (if invisible - (overlay-put ov 'invisible t) + (when todo-blocked (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (overlay-put ov 'org-type 'org-blocked-todo)) - (forward-line)))) + (when invisible + (org-agenda-filter-hide-line 'todo-blocked))) + (move-beginning-of-line 2)))) (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...done"))) (defun org-agenda--mark-blocked-entry (entry) - "For ENTRY a string with the text property `org-hd-marker', if -the header at `org-hd-marker' is blocked according to + "If ENTRY is blocked, mark it for fontification or invisibility. + +If the header at `org-hd-marker' is blocked according to `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is 'invisible and the header is not blocked by checkboxes, set the text property `org-todo-blocked' to `invisible', otherwise set it @@ -4042,7 +4073,9 @@ to t." (put-text-property 0 (length entry) 'org-todo-blocked (if really-invisible 'invisible t) - entry))))))) + entry) + (put-text-property + 0 (length entry) 'org-filter-type 'todo-blocked entry))))))) entry) (defvar org-agenda-skip-function nil @@ -4066,8 +4099,10 @@ continue from there." (when (or (save-excursion (goto-char p) (looking-at comment-start-skip)) (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) - (get-text-property p :org-archived) - (org-end-of-subtree t)) + (or (and (get-text-property p :org-archived) + (org-end-of-subtree t)) + (and (member org-archive-tag org-file-tags) + (goto-char (point-max))))) (and org-agenda-skip-comment-trees (get-text-property p :org-comment) (org-end-of-subtree t)) @@ -4099,8 +4134,8 @@ functions do." (defun org-agenda-new-marker (&optional pos) "Return a new agenda marker. -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." +Marker 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 @@ -4182,7 +4217,6 @@ See the docstring of `org-read-date' for details.") (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-arg-loc nil) ; local variable -(defvar org-agenda-buffer-tmp-name nil) ;;;###autoload (defun org-agenda-list (&optional arg start-day span with-hour) "Produce a daily/weekly view from all files in variable `org-agenda-files'. @@ -4210,15 +4244,13 @@ items if they have an hour specification like [h]h:mm." (user-error "Agenda creation impossible for this span(=%d days)." span))) (catch 'exit (setq org-agenda-buffer-name - (or org-agenda-buffer-tmp-name - (and org-agenda-doing-sticky-redo org-agenda-buffer-name) - (when org-agenda-sticky + (org-agenda--get-buffer-name + (and 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*")) + (t "*Org Agenda(a)*"))))) (org-agenda-prepare "Day/Week") (setq start-day (or start-day org-agenda-start-day)) (when (stringp start-day) @@ -4365,7 +4397,7 @@ items if they have an hour specification like [h]h:mm." (insert tbl))) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (unless (or (not (get-buffer-window)) + (unless (or (not (get-buffer-window org-agenda-buffer-name)) (and (pos-visible-in-window-p (point-min)) (pos-visible-in-window-p (point-max)))) (goto-char (1- (point-max))) @@ -4508,12 +4540,15 @@ is active." (edit-at string)) 'org-agenda-search-history))) (catch 'exit - (when org-agenda-sticky - (setq org-agenda-buffer-name - (if (stringp string) - (format "*Org Agenda(%s:%s)*" - (or org-keys (or (and todo-only "S") "s")) string) - (format "*Org Agenda(%s)*" (or (and todo-only "S") "s"))))) + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (if (stringp string) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "S") "s")) + string) + (format "*Org Agenda(%s)*" + (or (and todo-only "S") "s")))))) (org-agenda-prepare "SEARCH") (org-compile-prefix-format 'search) (org-set-sorting-strategy 'search) @@ -4760,12 +4795,13 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (completion-ignore-case t) kwds org-select-this-todo-keyword rtn rtnall files file pos) (catch 'exit - (when org-agenda-sticky - (setq org-agenda-buffer-name - (if (stringp org-select-this-todo-keyword) - (format "*Org Agenda(%s:%s)*" (or org-keys "t") - org-select-this-todo-keyword) - (format "*Org Agenda(%s)*" (or org-keys "t"))))) + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (if (stringp org-select-this-todo-keyword) + (format "*Org Agenda(%s:%s)*" (or org-keys "t") + org-select-this-todo-keyword) + (format "*Org Agenda(%s)*" (or org-keys "t")))))) (org-agenda-prepare "TODO") (setq kwds org-todo-keywords-for-agenda org-select-this-todo-keyword (if (stringp arg) arg @@ -4774,8 +4810,12 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (nth (1- arg) kwds)))) (when (equal arg '(4)) (setq org-select-this-todo-keyword - (completing-read "Keyword (or KWD1|K2D2|...): " - (mapcar #'list kwds) nil nil))) + (mapconcat #'identity + (let ((crm-separator "|")) + (completing-read-multiple + "Keyword (or KWD1|KWD2|...): " + (mapcar #'list kwds) nil nil)) + "|"))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) @@ -4848,13 +4888,15 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (when (and (stringp match) (not (string-match "\\S-" match))) (setq match nil)) (catch 'exit - ;; TODO: this code is repeated a lot... - (when org-agenda-sticky - (setq org-agenda-buffer-name - (if (stringp match) - (format "*Org Agenda(%s:%s)*" - (or org-keys (or (and todo-only "M") "m")) match) - (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (if (stringp match) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "M") "m")) + match) + (format "*Org Agenda(%s)*" + (or (and todo-only "M") "m")))))) (setq matcher (org-make-tags-matcher match)) ;; Prepare agendas (and `org-tag-alist-for-agenda') before ;; expanding tags within `org-make-tags-matcher' @@ -5135,6 +5177,7 @@ of what a project is and how to check if it stuck, customize the variable (cons 'org-diary-default-entry diary-list-entries-hook)) (diary-file-name-prefix nil) ; turn this feature off (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) + (diary-time-regexp (concat "^" diary-time-regexp)) entries (org-disable-agenda-to-diary t)) (save-excursion @@ -5284,7 +5327,8 @@ function from a program - use `org-agenda-get-day-entries' instead." (when results (setq results (mapcar (lambda (i) (replace-regexp-in-string - org-link-bracket-re "\\2" i)) results)) + org-link-bracket-re "\\2" i)) + results)) (concat (org-agenda-finalize-entries results) "\n")))) ;;; Agenda entry finders @@ -5503,10 +5547,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (cond ((eq org-agenda-todo-ignore-scheduled 'future) (> (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((eq org-agenda-todo-ignore-scheduled 'past) (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((numberp org-agenda-todo-ignore-scheduled) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-scheduled)) @@ -5519,10 +5565,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (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)) + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((eq org-agenda-todo-ignore-deadlines 'past) (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((numberp org-agenda-todo-ignore-deadlines) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-deadlines)) @@ -5546,10 +5594,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (cond ((eq org-agenda-todo-ignore-timestamp 'future) (> (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((eq org-agenda-todo-ignore-timestamp 'past) (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((numberp org-agenda-todo-ignore-timestamp) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-timestamp)) @@ -6457,7 +6507,6 @@ scheduled items with an hour specification like [h]h:mm." (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 nil (not inherited-tags))) (setq level (make-string (org-reduced-level (org-outline-level)) ? )) (looking-at "\\*+[ \t]+\\(.*\\)") @@ -6475,12 +6524,19 @@ scheduled items with an hour specification like [h]h:mm." org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) head level category tags - (cond ((and (= d1 d0) (= d2 d0)) - (concat "<" start-time ">--<" end-time ">")) - ((= d1 d0) - (concat "<" start-time ">")) - ((= d2 d0) - (concat "<" end-time ">"))) + (save-match-data + (let ((hhmm1 (and (string-match org-ts-regexp1 s1) + (match-string 6 s1))) + (hhmm2 (and (string-match org-ts-regexp1 s2) + (match-string 6 s2)))) + (cond ((string= hhmm1 hhmm2) + (concat "<" start-time ">--<" end-time ">")) + ((and (= d1 d0) (= d2 d0)) + (concat "<" start-time ">--<" end-time ">")) + ((= d1 d0) + (concat "<" start-time ">")) + ((= d2 d0) + (concat "<" end-time ">"))))) remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker @@ -6676,8 +6732,8 @@ Any match of REMOVE-RE will be removed from TXT." (org-add-props rtn nil 'org-category category 'tags (mapcar 'org-downcase-keep-props tags) - 'org-highest-priority org-highest-priority - 'org-lowest-priority org-lowest-priority + 'org-priority-highest org-priority-highest + 'org-priority-lowest org-priority-lowest 'time-of-day time-of-day 'duration duration 'breadcrumbs breadcrumbs @@ -6872,7 +6928,7 @@ HH:MM." (< t0 1000)) "0" "") (if (< t0 100) "0" "") (if (< t0 10) "0" "") - (int-to-string t0)))) + (number-to-string t0)))) (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) (defvar org-agenda-before-sorting-filter-function nil @@ -6920,7 +6976,7 @@ The optional argument TYPE tells the agenda type." (when max-effort (setq list (org-agenda-limit-entries list 'effort-minutes max-effort - (lambda (e) (or e (if org-sort-agenda-noeffort-is-high + (lambda (e) (or e (if org-agenda-sort-noeffort-is-high 32767 -1)))))) (when max-todo (setq list (org-agenda-limit-entries list 'todo-state max-todo))) @@ -7006,7 +7062,8 @@ The optional argument TYPE tells the agenda type." ;; that isn't there. pl (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") - x pl) pl)) + x pl) + pl)) (add-text-properties (or (match-end 1) (match-end 0)) (match-end 0) (list 'face (org-get-todo-face (match-string 2 x))) @@ -7033,7 +7090,7 @@ The optional argument TYPE tells the agenda type." (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)) + (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1)) ;; `effort-minutes' property is not directly accessible from ;; the strings, but is stored as a property in `txt'. (ea (or (get-text-property @@ -7083,12 +7140,14 @@ The optional argument TYPE tells the agenda type." (case-fold-search nil)) (when pla (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") - "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") + ta) (setq ta (substring ta (match-end 0)))) (setq ta (downcase ta))) (when plb (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") - "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb) + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") + tb) (setq tb (substring tb (match-end 0)))) (setq tb (downcase tb))) (cond ((not (or ta tb)) nil) @@ -7109,7 +7168,7 @@ The optional argument TYPE tells the agenda type." (defsubst org-cmp-time (a b) "Compare the time-of-day values of strings A and B." - (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) + (let* ((def (if org-agenda-sort-notime-is-late 9901 -1)) (ta (or (get-text-property 1 'time-of-day a) def)) (tb (or (get-text-property 1 'time-of-day b) def))) (cond ((< ta tb) -1) @@ -7121,7 +7180,7 @@ When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or \"timestamp_ia\", compare within each of these type. When TYPE is the empty string, compare all timestamps without respect of their type." - (let* ((def (and (not org-sort-agenda-notime-is-late) -1)) + (let* ((def (and (not org-agenda-sort-notime-is-late) -1)) (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) (get-text-property 1 'ts-date a)) def)) @@ -7351,6 +7410,10 @@ agenda." (cond ((eq org-agenda-window-setup 'other-frame) (delete-frame)) + ((eq org-agenda-window-setup 'other-tab) + (if (fboundp 'tab-bar-close-tab) + (tab-bar-close-tab) + (user-error "Your version of Emacs does not have tab bar mode support"))) ((and org-agenda-restore-windows-after-quit wconf) ;; Maybe restore the pre-agenda window configuration. Reset @@ -7470,7 +7533,7 @@ in the agenda." (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) (and cols (called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) - (recenter window-line))) + (when (called-interactively-p 'any) (recenter window-line)))) (defun org-agenda-redo-all (&optional exhaustive) "Rebuild all agenda views in the current buffer. @@ -7508,7 +7571,8 @@ When there is already a category filter in place, this command removes the filte (cat (org-agenda-filter-apply (setq org-agenda-category-filter - (list (concat "+" cat))) 'category)) + (list (concat "+" cat))) + 'category)) (t (error "No category at point")))))) (defun org-find-top-headline (&optional pos) @@ -7520,7 +7584,10 @@ search from." (when pos (goto-char pos)) ;; Skip up to the topmost parent. (while (org-up-heading-safe)) - (ignore-errors (nth 4 (org-heading-components)))))) + (ignore-errors + (replace-regexp-in-string + "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" "" + (nth 4 (org-heading-components))))))) (defvar org-agenda-filtered-by-top-headline nil) (defun org-agenda-filter-by-top-headline (strip) @@ -7572,8 +7639,9 @@ This last option is in practice not very useful, but it is available for consistency with the other filter commands." (interactive "P") (let* ((efforts (split-string - (or (cdr (assoc (concat org-effort-property "_ALL") - org-global-properties)) + (or (cdr (assoc-string (concat org-effort-property "_ALL") + org-global-properties + t)) "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. @@ -7614,7 +7682,6 @@ consistency with the other filter commands." (if keep current nil))) (org-agenda-filter-apply org-agenda-effort-filter 'effort))))) - (defun org-agenda-filter (&optional strip-or-accumulate) "Prompt for a general filter string and apply it to the agenda. @@ -7665,11 +7732,18 @@ the variable `org-agenda-auto-exclude-function'." (let* ((tag-list (org-agenda-get-represented-tags)) (category-list (org-agenda-get-represented-categories)) (negate (equal strip-or-accumulate '(4))) + (cf (mapconcat #'identity org-agenda-category-filter "")) + (tf (mapconcat #'identity org-agenda-tag-filter "")) + (rpl-fn (lambda (c) (replace-regexp-in-string "^\+" "" (or (car c) "")))) + (ef (replace-regexp-in-string "^\+" "" (or (car org-agenda-effort-filter) ""))) + (rf (replace-regexp-in-string "^\+" "" (or (car org-agenda-regexp-filter) ""))) + (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) (f-string (completing-read (concat (if negate "Negative filter" "Filter") " [+cat-tag<0:10-/regexp/]: ") - 'org-agenda-filter-completion-function)) + 'org-agenda-filter-completion-function + nil nil ff)) (keep (or (if (string-match "^\\+[+-]" f-string) (progn (setq f-string (substring f-string 1)) t)) (equal strip-or-accumulate '(16)))) @@ -7678,6 +7752,11 @@ the variable `org-agenda-auto-exclude-function'." (fe (if keep org-agenda-effort-filter)) (fr (if keep org-agenda-regexp-filter)) pm s) + ;; If the filter contains a double-quoted string, replace a + ;; single hyphen by the arbitrary and temporary string "~~~" + ;; to disambiguate such hyphens from syntactic ones. + (setq f-string (replace-regexp-in-string + "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string)) (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string) (setq pm (if (match-beginning 1) (match-string 1 f-string) "+")) (when negate @@ -7685,12 +7764,15 @@ the variable `org-agenda-auto-exclude-function'." (cond ((match-beginning 3) ;; category or tag - (setq s (match-string 3 f-string)) + (setq s (replace-regexp-in-string ; Remove the temporary special string. + "~~~" "-" (match-string 3 f-string))) (cond ((member s tag-list) (add-to-list 'ft (concat pm s) 'append 'equal)) ((member s category-list) - (add-to-list 'fc (concat pm s) 'append 'equal)) + (add-to-list 'fc (concat pm ; Remove temporary double quotes. + (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) + 'append 'equal)) (t (message "`%s%s' filter ignored because tag/category is not represented" pm s)))) @@ -7705,15 +7787,15 @@ the variable `org-agenda-auto-exclude-function'." (and fc (org-agenda-filter-apply (setq org-agenda-category-filter fc) 'category)) (and ft (org-agenda-filter-apply - (setq org-agenda-tag-filter ft) 'tag)) + (setq org-agenda-tag-filter ft) 'tag 'expand)) (and fe (org-agenda-filter-apply (setq org-agenda-effort-filter fe) 'effort)) (and fr (org-agenda-filter-apply (setq org-agenda-regexp-filter fr) 'regexp)) - ))) + (run-hooks 'org-agenda-filter-hook)))) (defun org-agenda-filter-completion-function (string _predicate &optional flag) - "Complete a complex filter string + "Complete a complex filter string. FLAG specifies the type of completion operation to perform. This function is passed as a collection function to `completing-read', which see." @@ -7732,8 +7814,9 @@ which see." (org-agenda-get-represented-tags)))) ((member operator '("<" ">" "=")) (setq table (split-string - (or (cdr (assoc (concat org-effort-property "_ALL") - org-global-properties)) + (or (cdr (assoc-string (concat org-effort-property "_ALL") + org-global-properties + t)) "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00") " +"))) (t (setq table nil))) @@ -7760,7 +7843,9 @@ which see." (org-agenda-filter-show-all-top-filter)) (when org-agenda-effort-filter (org-agenda-filter-show-all-effort)) - (org-agenda-finalize)) + (org-agenda-finalize) + (when (called-interactively-p 'interactive) + (message "All agenda filters removed"))) (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude) "Keep only those lines in the agenda buffer that have a specific tag. @@ -7860,8 +7945,12 @@ also press `-' or `+' to switch between filtering and excluding." pos 'org-category nil (point-max)))) (push (get-text-property pos 'org-category) categories)) (setq org-agenda-represented-categories - (nreverse (org-uniquify (delq nil categories)))))))) + ;; Enclose category names with a hyphen in double + ;; quotes to process them specially in `org-agenda-filter'. + (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s)) + (nreverse (org-uniquify (delq nil categories))))))))) +(defvar org-tag-groups-alist-for-agenda) (defun org-agenda-get-represented-tags () "Return a list of all tags used in this agenda buffer. These will be lower-case, for filtering." @@ -7873,15 +7962,27 @@ These will be lower-case, for filtering." pos 'tags nil (point-max)))) (setq tt (get-text-property pos 'tags)) (if tt (push tt tags-lists))) - (setq org-agenda-represented-tags + (setq tags-lists (nreverse (org-uniquify - (delq nil (apply 'append tags-lists))))))))) + (delq nil (apply 'append tags-lists))))) + (dolist (tag tags-lists) + (mapc + (lambda (group) + (when (member tag (mapcar #'downcase group)) + (push (downcase (car group)) tags-lists))) + org-tag-groups-alist-for-agenda)) + (setq org-agenda-represented-tags tags-lists))))) (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) + (let ((multi-pos-cats + (and (eq type 'category) + (string-match-p "\\+.*\\+" + (mapconcat (lambda (cat) (substring cat 0 1)) + filter "")))) + f f1) (cond ;; Tag filter ((eq type 'tag) @@ -7925,7 +8026,7 @@ tags in the FILTER if any of the tags in FILTER are grouptags." filter))) (dolist (x filter) (push (org-agenda-filter-effort-form x) f)))) - (cons 'and (nreverse f)))) + (cons (if multi-pos-cats 'or 'and) (nreverse f)))) (defun org-agenda-filter-make-matcher-tag-exp (tags op) "Return a form associated to tag-expression TAGS. @@ -7965,12 +8066,13 @@ If the line does not have an effort defined, return nil." ;; 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)) + (or effort (if org-agenda-sort-noeffort-is-high 32767 -1)) value))) (defun org-agenda-filter-expand-tags (filter &optional no-operator) "Expand group tags in FILTER for the agenda. -When NO-OPERATOR is non-nil, do not add the + operator to returned tags." +When NO-OPERATOR is non-nil, do not add the + operator to +returned tags." (if org-group-tags (let ((case-fold-search t) rtn) (mapc @@ -7987,34 +8089,33 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags." filter)) (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." + "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 (when 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 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 - (and (eq type 'category) - (not (equal (substring (car filter) 0 1) "-")))) - (org-agenda-set-mode-name) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (org-get-at-bol 'org-hd-marker) - (progn - (setq tags (org-get-at-bol 'tags) - cat (org-agenda-get-category) - txt (org-get-at-bol 'txt)) - (unless (eval org-agenda-filter-form) - (org-agenda-filter-hide-line type)) - (beginning-of-line 2)) - (beginning-of-line 2)))) - (when (get-char-property (point) 'invisible) - (ignore-errors (org-agenda-previous-line))))) + (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 + (and (eq type 'category) + (not (equal (substring (car filter) 0 1) "-")))) + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)) + (let ((tags (org-get-at-bol 'tags)) + (cat (org-agenda-get-category)) + (txt (or (org-get-at-bol 'txt) ""))) + (unless (eval org-agenda-filter-form) + (org-agenda-filter-hide-line type)))) + (beginning-of-line 2))) + (when (get-char-property (point) 'invisible) + (ignore-errors (org-agenda-previous-line)))) (defun org-agenda-filter-top-headline-apply (hl &optional negative) "Filter by top headline HL." @@ -8034,16 +8135,17 @@ tags in the FILTER if any of the tags in FILTER are grouptags." org-agenda-filtered-by-top-headline t)) (defun org-agenda-filter-hide-line (type) - "Hide lines with TYPE in the agenda buffer." - (let* ((b (max (point-min) (1- (point-at-bol)))) - (e (point-at-eol))) + "If current line is TYPE, hide it in the agenda buffer." + (let* (buffer-invisibility-spec + (beg (max (point-min) (1- (point-at-bol)))) + (end (point-at-eol))) (let ((inhibit-read-only t)) (add-text-properties - b e `(invisible org-filtered org-filter-type ,type))))) + beg end `(invisible org-filtered org-filter-type ,type))))) (defun org-agenda-remove-filter (type) - (interactive) "Remove filter of type TYPE from the agenda buffer." + (interactive) (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t) pos) @@ -8517,7 +8619,10 @@ log items, nothing else." When called with a prefix argument, include all archive files as well." (interactive "P") (setq org-agenda-archives-mode - (if with-files t (if org-agenda-archives-mode nil 'trees))) + (cond ((and with-files (eq org-agenda-archives-mode t)) nil) + (with-files t) + (org-agenda-archives-mode nil) + (t 'trees))) (org-agenda-set-mode-name) (org-agenda-redo) (message @@ -8584,14 +8689,14 @@ When called with a prefix argument, include all archive files as well." (if (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) '(:eval (propertize - (concat "[" + (concat "[" (mapconcat 'identity (append (get 'org-agenda-category-filter :preset-filter) org-agenda-category-filter) "") - "]") + "]") 'face 'org-agenda-filter-category 'help-echo "Category used in filtering")) "") (if (or org-agenda-tag-filter @@ -8703,6 +8808,7 @@ When called with a prefix argument, include all archive files as well." (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) + ;; FIXME: use `org-switch-to-buffer-other-window'? (switch-to-buffer-other-window buffer) (widen) (push-mark) @@ -8721,92 +8827,143 @@ When called with a prefix argument, include all archive files as well." "Normal hook run after an item has been shown from the agenda. Point is in the buffer where the item originated.") +;; Defined later in org-agenda.el +(defvar org-agenda-loop-over-headlines-in-active-region nil) + +(defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete) + "Between region BEG and END, call agenda command CMD. +When optional argument ARG is non-nil or FORCE-ARG is `t', pass +ARG to CMD. When optional argument DELETE is non-nil, assume CMD +deletes the agenda entry and don't move to the next entry." + (save-excursion + (goto-char beg) + (let ((mend (move-marker (make-marker) end)) + (all (eq org-agenda-loop-over-headlines-in-active-region t)) + (match (and (stringp org-agenda-loop-over-headlines-in-active-region) + org-agenda-loop-over-headlines-in-active-region)) + (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level) + (org-get-at-bol 'level)))) + (while (< (point) mend) + (let ((ov (make-overlay (point) (point-at-eol)))) + (if (not (or all + (and match (looking-at-p match)) + (eq level (org-get-at-bol 'level)))) + (org-agenda-next-item 1) + (overlay-put ov 'face 'region) + (if (or arg force-arg) (funcall cmd arg) (funcall cmd)) + (when (not delete) (org-agenda-next-item 1)) + (delete-overlay ov))))))) + +;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*, +;; kill,set-property,set-effort] commands may loop over agenda +;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark' +;; use their own mechanisms on active regions. +(defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body) + "Maybe loop over agenda entries and perform CMD. +Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." + (declare (debug t)) + `(if (and (called-interactively-p 'any) + org-agenda-loop-over-headlines-in-active-region + (org-region-active-p)) + (org-agenda-do-in-region + (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete) + ,@body)) + (defun org-agenda-kill () "Kill the entry or subtree belonging to the current agenda entry." (interactive) - (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((bufname-orig (buffer-name)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (type (org-get-at-bol 'type)) - dbeg dend (n 0)) - (org-with-remote-undo buffer - (with-current-buffer buffer - (save-excursion - (goto-char pos) - (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) - (setq dbeg (progn (org-back-to-heading t) (point)) - dend (org-end-of-subtree t t)) - (setq dbeg (point-at-bol) - dend (min (point-max) (1+ (point-at-eol))))) - (goto-char dbeg) - (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) - (when (or (eq t org-agenda-confirm-kill) - (and (numberp org-agenda-confirm-kill) - (> n org-agenda-confirm-kill))) - (let ((win-conf (current-window-configuration))) - (unwind-protect - (and - (prog2 - (org-agenda-tree-to-indirect-buffer nil) - (not (y-or-n-p - (format "Delete entry with %d lines in buffer \"%s\"? " - n (buffer-name buffer)))) - (kill-buffer org-last-indirect-buffer)) - (error "Abort")) - (set-window-configuration win-conf)))) - (let ((org-agenda-buffer-name bufname-orig)) - (org-remove-subtree-entries-from-agenda buffer dbeg dend)) - (with-current-buffer buffer (delete-region dbeg dend)) - (message "Agenda item and source killed")))) + (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) + (org-agenda-maybe-loop + #'org-agenda-kill nil nil t + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (type (org-get-at-bol 'type)) + dbeg dend (n 0)) + (org-with-remote-undo buffer + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) + (setq dbeg (progn (org-back-to-heading t) (point)) + dend (org-end-of-subtree t t)) + (setq dbeg (point-at-bol) + dend (min (point-max) (1+ (point-at-eol))))) + (goto-char dbeg) + (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) + (when (or (eq t org-agenda-confirm-kill) + (and (numberp org-agenda-confirm-kill) + (> n org-agenda-confirm-kill))) + (let ((win-conf (current-window-configuration))) + (unwind-protect + (and + (prog2 + (org-agenda-tree-to-indirect-buffer nil) + (not (y-or-n-p + (format "Delete entry with %d lines in buffer \"%s\"? " + n (buffer-name buffer)))) + (kill-buffer org-last-indirect-buffer)) + (error "Abort")) + (set-window-configuration win-conf)))) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda buffer dbeg dend)) + (with-current-buffer buffer (delete-region dbeg dend)) + (message "Agenda item and source killed"))))) (defvar org-archive-default-command) ; defined in org-archive.el (defun org-agenda-archive-default () "Archive the entry or subtree belonging to the current agenda entry." (interactive) (require 'org-archive) - (org-agenda-archive-with org-archive-default-command)) + (funcall-interactively + #'org-agenda-archive-with org-archive-default-command)) (defun org-agenda-archive-default-with-confirmation () "Archive the entry or subtree belonging to the current agenda entry." (interactive) (require 'org-archive) - (org-agenda-archive-with org-archive-default-command 'confirm)) + (funcall-interactively + #'org-agenda-archive-with org-archive-default-command 'confirm)) (defun org-agenda-archive () "Archive the entry or subtree belonging to the current agenda entry." (interactive) - (org-agenda-archive-with 'org-archive-subtree)) + (funcall-interactively + #'org-agenda-archive-with 'org-archive-subtree)) (defun org-agenda-archive-to-archive-sibling () "Move the entry to the archive sibling." (interactive) - (org-agenda-archive-with 'org-archive-to-archive-sibling)) + (funcall-interactively + #'org-agenda-archive-with 'org-archive-to-archive-sibling)) (defun org-agenda-archive-with (cmd &optional confirm) "Move the entry to the archive sibling." (interactive) - (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((bufname-orig (buffer-name)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (org-with-remote-undo buffer - (with-current-buffer buffer - (if (derived-mode-p 'org-mode) - (if (and confirm - (not (y-or-n-p "Archive this subtree or entry? "))) - (error "Abort") - (save-window-excursion - (goto-char pos) - (let ((org-agenda-buffer-name bufname-orig)) - (org-remove-subtree-entries-from-agenda)) - (org-back-to-heading t) - (funcall cmd))) - (error "Archiving works only in Org files")))))) + (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) + (org-agenda-maybe-loop + #'org-agenda-archive-with cmd nil t + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (if (derived-mode-p 'org-mode) + (if (and confirm + (not (y-or-n-p "Archive this subtree or entry? "))) + (error "Abort") + (save-window-excursion + (goto-char pos) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-back-to-heading t) + (let ((org-archive-from-agenda t)) + (funcall cmd)))) + (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. @@ -8893,12 +9050,16 @@ It also looks at the text of the entry itself." (setq trg (and (string-match org-link-bracket-re l) (match-string 1 l))) (if (or (not trg) (string-match org-link-any-re trg)) - (org-with-wide-buffer - (goto-char marker) - (when (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point))) + ;; Don't use `org-with-wide-buffer' here as + ;; opening the link may result in moving the point + (save-restriction + (widen) + (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 + ;; FIXME: use `org-switch-to-buffer-other-window'? (switch-to-buffer-other-window buffer) (widen) (goto-char marker) @@ -8981,7 +9142,6 @@ fold drawers." (narrow-to-region (org-entry-beginning-position) (org-entry-end-position)) (org-show-all '(drawers)))) - (when arg ) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -9002,8 +9162,7 @@ The prefix arg selects the amount of information to display: 1 just show the entry according to defaults. 2 show the children view 3 show the subtree view -4 show the entire subtree and any LOGBOOK drawers -5 show the entire subtree and any drawers +4 show the entire subtree and any drawers With prefix argument FULL-ENTRY, make the entire entry visible if it was hidden in the outline." (interactive "p") @@ -9033,13 +9192,7 @@ if it was hidden in the outline." (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) - ((= more 4) - (outline-show-subtree) - (save-excursion - (org-back-to-heading) - (org-cycle-hide-drawers 'subtree '("LOGBOOK"))) - (message "Remote: SUBTREE AND LOGBOOK")) - ((> more 4) + ((> more 3) (outline-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) @@ -9154,44 +9307,46 @@ 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 file." (interactive "P") (org-agenda-check-no-diary) - (let* ((col (current-column)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (hdmarker (org-get-at-bol 'org-hd-marker)) - (todayp (org-agenda-today-p (org-get-at-bol 'day))) - (inhibit-read-only t) - org-loop-over-headlines-in-active-region - org-agenda-headline-snapshot-before-repeat newhead just-one) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (let ((current-prefix-arg arg)) - (call-interactively 'org-todo)) - (and (bolp) (forward-char 1)) - (setq newhead (org-get-heading)) - (when (and (bound-and-true-p - org-agenda-headline-snapshot-before-repeat) - (not (equal org-agenda-headline-snapshot-before-repeat - newhead)) - todayp) - (setq newhead org-agenda-headline-snapshot-before-repeat - just-one t)) - (save-excursion - (org-back-to-heading) - (move-marker org-last-heading-marker (point)))) - (beginning-of-line 1) - (save-window-excursion - (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) - (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-agenda-mark-clocking-task)))) + (org-agenda-maybe-loop + #'org-agenda-todo arg nil nil + (let* ((col (current-column)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (hdmarker (org-get-at-bol 'org-hd-marker)) + (todayp (org-agenda-today-p (org-get-at-bol 'day))) + (inhibit-read-only t) + org-loop-over-headlines-in-active-region + org-agenda-headline-snapshot-before-repeat newhead just-one) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (let ((current-prefix-arg arg)) + (call-interactively 'org-todo)) + (and (bolp) (forward-char 1)) + (setq newhead (org-get-heading)) + (when (and (bound-and-true-p + org-agenda-headline-snapshot-before-repeat) + (not (equal org-agenda-headline-snapshot-before-repeat + newhead)) + todayp) + (setq newhead org-agenda-headline-snapshot-before-repeat + just-one t)) + (save-excursion + (org-back-to-heading) + (move-marker org-last-heading-marker (point)))) + (beginning-of-line 1) + (save-window-excursion + (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) + (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-agenda-mark-clocking-task))))) (defun org-agenda-add-note (&optional arg) "Add a time-stamped note to the entry at point." @@ -9330,9 +9485,9 @@ 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)) - (org-show-priority) - (unless org-enable-priority-commands - (error "Priority commands are disabled")) + (org-priority-show) + (unless org-priority-enable-commands + (user-error "Priority commands are disabled")) (org-agenda-check-no-diary) (let* ((col (current-column)) (marker (or (org-get-at-bol 'org-marker) @@ -9383,59 +9538,65 @@ Called with a universal prefix arg, show the priority instead of setting it." "Set a property for the current headline." (interactive) (org-agenda-check-no-diary) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (call-interactively 'org-set-property))))) + (org-agenda-maybe-loop + #'org-agenda-set-property nil nil nil + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (call-interactively 'org-set-property)))))) (defun org-agenda-set-effort () "Set the effort property for the current headline." (interactive) (org-agenda-check-no-diary) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (call-interactively 'org-set-effort) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker)))) + (org-agenda-maybe-loop + #'org-agenda-set-effort nil nil nil + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (call-interactively 'org-set-effort) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker))))) (defun org-agenda-toggle-archive-tag () "Toggle the archive tag for the current entry." (interactive) (org-agenda-check-no-diary) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (call-interactively 'org-toggle-archive-tag) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1)))) + (org-agenda-maybe-loop + #'org-agenda-toggle-archive-tag nil nil nil + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (call-interactively 'org-toggle-archive-tag) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))))) (defun org-agenda-do-date-later (arg) (interactive "P") @@ -9541,8 +9702,11 @@ Called with a universal prefix arg, show the priority instead of setting it." (goto-char (point-max)) (while (not (bobp)) (when (equal marker (org-get-at-bol 'org-marker)) - (remove-text-properties (point-at-bol) (point-at-eol) '(display nil)) - (org-move-to-column (- (window-width) (length stamp)) t) + (remove-text-properties (line-beginning-position) + (line-end-position) + '(display nil)) + (org-move-to-column + (- (/ (window-width nil t) (window-font-width)) (length stamp)) t) (add-text-properties (1- (point)) (point-at-eol) (list 'display (org-add-props stamp nil @@ -9557,18 +9721,20 @@ be used to request time specification in the time stamp." (interactive "P") (org-agenda-check-type t 'agenda) (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) - (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) - (org-agenda-show-new-time marker org-last-changed-timestamp)) - (message "Time stamp changed to %s" org-last-changed-timestamp))) + (org-agenda-maybe-loop + #'org-agenda-date-prompt arg t nil + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) + (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) + (org-agenda-show-new-time marker org-last-changed-timestamp)) + (message "Time stamp changed to %s" org-last-changed-timestamp)))) (defun org-agenda-schedule (arg &optional time) "Schedule the item at point. @@ -9576,20 +9742,22 @@ ARG is passed through to `org-schedule'." (interactive "P") (org-agenda-check-type t 'agenda 'todo 'tags 'search) (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (type (marker-insertion-type marker)) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - ts) - (set-marker-insertion-type marker t) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (setq ts (org-schedule arg time))) - (org-agenda-show-new-time marker ts " S")) - (message "%s" ts))) + (org-agenda-maybe-loop + #'org-agenda-schedule arg t nil + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (type (marker-insertion-type marker)) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + ts) + (set-marker-insertion-type marker t) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-schedule arg time))) + (org-agenda-show-new-time marker ts " S")) + (message "%s" ts)))) (defun org-agenda-deadline (arg &optional time) "Schedule the item at point. @@ -9597,18 +9765,20 @@ ARG is passed through to `org-deadline'." (interactive "P") (org-agenda-check-type t 'agenda 'todo 'tags 'search) (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - ts) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (setq ts (org-deadline arg time))) - (org-agenda-show-new-time marker ts " D")) - (message "%s" ts))) + (org-agenda-maybe-loop + #'org-agenda-deadline arg t nil + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + ts) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-deadline arg time))) + (org-agenda-show-new-time marker ts " D")) + (message "%s" ts)))) (defun org-agenda-clock-in (&optional arg) "Start the clock on the currently selected item." @@ -9636,7 +9806,7 @@ ARG is passed through to `org-deadline'." "Stop the currently running clock." (interactive) (unless (marker-buffer org-clock-marker) - (error "No running clock")) + (user-error "No running clock")) (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) @@ -9792,13 +9962,13 @@ the resulting entry will not be shown. When TEXT is empty, switch to (org-agenda-insert-diary-make-new-entry text)) (org-insert-time-stamp (org-time-from-absolute (calendar-absolute-from-gregorian d1)) - nil nil nil nil time2)) + nil nil nil nil time2)) (end-of-line 0)) ((block) ;; Wrap this in (strictly unnecessary) parens because ;; otherwise the indentation gets confused by the ;; special meaning of 'block (when (> (calendar-absolute-from-gregorian d1) - (calendar-absolute-from-gregorian d2)) + (calendar-absolute-from-gregorian d2)) (setq d1 (prog1 d2 (setq d2 d1)))) (if (eq org-agenda-insert-diary-strategy 'top-level) (org-agenda-insert-diary-as-top-level text) @@ -10062,13 +10232,13 @@ When ARG is greater than one mark ARG lines." (goto-char (point-min)) (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))) + (setq txt-at-point + (get-text-property (match-beginning 0) 'txt))) (if (get-char-property (point) 'invisible) (beginning-of-line 2) - (when (string-match regexp txt-at-point) + (when (string-match-p regexp txt-at-point) (setq entries-marked (1+ entries-marked)) (call-interactively 'org-agenda-bulk-mark))))) - (unless entries-marked (message "No entry matching this regexp.")))) @@ -10138,6 +10308,33 @@ bulk action." :version "24.1" :type 'boolean) +(defcustom org-agenda-loop-over-headlines-in-active-region t + "Shall some commands act upon headlines in the active region? + +When set to t, some commands will be performed in all headlines +within the active region. + +When set to `start-level', some commands will be performed in all +headlines within the active region, provided that these headlines +are of the same level than the first one. + +When set to a regular expression, those commands will be +performed on the matching headlines within the active region. + +The list of commands is: `org-agenda-schedule', +`org-agenda-deadline', `org-agenda-date-prompt', +`org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'. + +See `org-loop-over-headlines-in-active-region' for the equivalent +option for Org buffers." + :type '(choice (const :tag "Don't loop" nil) + (const :tag "All headlines in active region" t) + (const :tag "In active region, headlines at the same level than the first one" start-level) + (regexp :tag "Regular expression matcher")) + :version "27.1" + :package-version '(Org . "9.4") + :group 'org-agenda) + (defun org-agenda-bulk-action (&optional arg) "Execute an remote-editing action on all marked entries. The prefix arg is passed through to the command if possible." @@ -10547,6 +10744,15 @@ when defining today." (org-extend-today-until (1+ hour))) (org-agenda-todo arg))) +(defun org-agenda-ctrl-c-ctrl-c () + "Set tags in agenda buffer." + (interactive) + (org-agenda-set-tags)) + (provide 'org-agenda) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-agenda.el ends here diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index b33025be0f8..4a0de3cb5a6 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -24,7 +24,7 @@ ;; ;;; Commentary: -;; This file contains the face definitions for Org. +;; This file contains the archive functionality for Org. ;;; Code: @@ -91,6 +91,25 @@ When a string, a %s formatter will be replaced by the file name." (const :tag "When archiving a subtree to the same file" infile) (const :tag "Always" t))) +(defcustom org-archive-subtree-save-file-p 'from-org + "Conditionally save the archive file after archiving a subtree. +This variable can be any of the following symbols: + +t saves in all cases. +`from-org' prevents saving from an agenda-view. +`from-agenda' saves only when the archive is initiated from an agenda-view. +nil prevents saving in all cases. + +Note that, regardless of this value, the archive buffer is never +saved when archiving into a location in the current buffer." + :group 'org-archive + :package-version '(Org . "9.4") + :type '(choice + (const :tag "Save archive buffer" t) + (const :tag "Save when archiving from agenda" from-agenda) + (const :tag "Save when archiving from an Org buffer" from-org) + (const :tag "Do not save"))) + (defcustom org-archive-save-context-info '(time file olpath category todo itags) "Parts of context info that should be stored as properties when archiving. When a subtree is moved to an archive file, it loses information given by @@ -230,12 +249,20 @@ direct children of this heading." ((find-buffer-visiting afile)) ((find-file-noselect afile)) (t (error "Cannot access file \"%s\"" afile)))) + (org-odd-levels-only + (if (local-variable-p 'org-odd-levels-only (current-buffer)) + org-odd-levels-only + tr-org-odd-levels-only)) level datetree-date datetree-subheading-p) - (when (string-match "\\`datetree/" heading) - ;; Replace with ***, to represent the 3 levels of headings the - ;; datetree has. - (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading)) - (setq datetree-subheading-p (> (length heading) 3)) + (when (string-match "\\`datetree/\\(\\**\\)" heading) + ;; "datetree/" corresponds to 3 levels of headings. + (let ((nsub (length (match-string 1 heading)))) + (setq heading (concat (make-string + (+ (if org-odd-levels-only 5 3) + (* (org-level-increment) nsub)) + ?*) + (substring heading (match-end 0)))) + (setq datetree-subheading-p (> nsub 0))) (setq datetree-date (org-date-to-gregorian (or (org-entry-get nil "CLOSED" t) time)))) (if (and (> (length heading) 0) @@ -290,11 +317,7 @@ direct children of this heading." (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))) + (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) (org-show-all '(headings blocks)) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) @@ -361,6 +384,15 @@ direct children of this heading." (point) (concat "ARCHIVE_" (upcase (symbol-name item))) value)))) + ;; Save the buffer, if it is not the same buffer and + ;; depending on `org-archive-subtree-save-file-p'. + (unless (eq this-buffer buffer) + (when (or (eq org-archive-subtree-save-file-p t) + (eq org-archive-subtree-save-file-p + (if (boundp 'org-archive-from-agenda) + 'from-agenda + 'from-org))) + (save-buffer))) (widen)))) ;; Here we are back in the original buffer. Everything seems ;; to have worked. So now run hooks, cut the tree and finish diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 1ed305c9ff3..e6aa97e0080 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -4,7 +4,6 @@ ;; Author: John Wiegley ;; Keywords: org data attachment - ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -41,6 +40,8 @@ (require 'org-id) (declare-function dired-dwim-target-directory "dired-aux") +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) (defgroup org-attach nil "Options concerning attachments in Org mode." @@ -129,8 +130,7 @@ Selective means to respect the inheritance setting in :type '(choice (const :tag "Don't use inheritance" nil) (const :tag "Inherit parent node attachments" t) - (const :tag "Respect org-use-property-inheritance" selective)) - :type 'boolean) + (const :tag "Respect org-use-property-inheritance" selective))) (defcustom org-attach-store-link-p nil "Non-nil means store a link to a file when attaching it." @@ -139,7 +139,8 @@ Selective means to respect the inheritance setting in :type '(choice (const :tag "Don't store link" nil) (const :tag "Link to origin location" t) - (const :tag "Link to the attach-dir location" attached))) + (const :tag "Attachment link to the attach-dir location" attached) + (const :tag "File link to the attach-dir location" file))) (defcustom org-attach-archive-delete nil "Non-nil means attachments are deleted upon archiving a subtree. @@ -254,16 +255,16 @@ Shows a list of commands and prompts for another key to execute a command." (get-text-property (point) 'org-marker))) (unless marker (error "No item in current line"))) - (save-excursion - (when marker - (set-buffer (marker-buffer marker)) - (goto-char marker)) - (org-back-to-heading t) + (org-with-point-at marker + (org-back-to-heading-or-point-min t) (save-excursion (save-window-excursion (unless org-attach-expert - (with-output-to-temp-buffer "*Org Attach*" - (princ + (org-switch-to-buffer-other-window "*Org Attach*") + (erase-buffer) + (setq cursor-type nil + header-line-format "Use C-v, M-v, C-n or C-p to navigate.") + (insert (concat "Attachment folder:\n" (or dir "Can't find an existing attachment-folder") @@ -286,11 +287,14 @@ Shows a list of commands and prompts for another key to execute a command." "Invalid `org-attach-commands' item: %S" entry)))) org-attach-commands - "\n")))))) + "\n"))))) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) - (message "Select command: [%s]" - (concat (mapcar #'caar org-attach-commands))) - (setq c (read-char-exclusive)) + (let ((msg (format "Select command: [%s]" + (concat (mapcar #'caar org-attach-commands))))) + (message msg) + (while (and (setq c (read-char-exclusive)) + (memq c '(14 16 22 134217846))) + (org-scroll c t))) (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) (let ((command (cl-some (lambda (entry) (and (memq c (nth 0 entry)) (nth 1 entry))) @@ -457,14 +461,6 @@ DIR-property exists (that is different from the unset one)." "Turn the autotag off." (org-attach-tag 'off)) -(defun org-attach-store-link (file) - "Add a link to `org-stored-link' when attaching a file. -Only do this when `org-attach-store-link-p' is non-nil." - (setq org-stored-links - (cons (list (org-attach-expand-link file) - (file-name-nondirectory file)) - org-stored-links))) - (defun org-attach-url (url) (interactive "MURL of the file to attach: \n") (let ((org-attach-method 'url)) @@ -491,7 +487,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from `org-attach-method'." (interactive (list - (read-file-name "File to keep as an attachment:" + (read-file-name "File to keep as an attachment: " (or (progn (require 'dired-aux) (dired-dwim-target-directory)) @@ -501,22 +497,30 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from (setq method (or method org-attach-method)) (let ((basename (file-name-nondirectory file))) (let* ((attach-dir (org-attach-dir 'get-create)) - (fname (expand-file-name basename attach-dir))) + (attach-file (expand-file-name basename attach-dir))) (cond - ((eq method 'mv) (rename-file file fname)) - ((eq method 'cp) (copy-file file fname)) - ((eq method 'ln) (add-name-to-file file fname)) - ((eq method 'lns) (make-symbolic-link file fname)) - ((eq method 'url) (url-copy-file file fname))) + ((eq method 'mv) (rename-file file attach-file)) + ((eq method 'cp) (copy-file file attach-file)) + ((eq method 'ln) (add-name-to-file file attach-file)) + ((eq method 'lns) (make-symbolic-link file attach-file)) + ((eq method 'url) (url-copy-file file attach-file))) (run-hook-with-args 'org-attach-after-change-hook attach-dir) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) - (org-attach-store-link fname)) + (push (list (concat "attachment:" (file-name-nondirectory attach-file)) + (file-name-nondirectory attach-file)) + org-stored-links)) ((eq org-attach-store-link-p t) - (org-attach-store-link file))) + (push (list (concat "file:" file) + (file-name-nondirectory file)) + org-stored-links)) + ((eq org-attach-store-link-p 'file) + (push (list (concat "file:" attach-file) + (file-name-nondirectory attach-file)) + org-stored-links))) (if visit-dir (dired attach-dir) - (message "File %S is now an attachment." basename))))) + (message "File %S is now an attachment" basename))))) (defun org-attach-attach-cp () "Attach a file by copying it." @@ -569,13 +573,18 @@ The attachment is created as an Emacs buffer." (defun org-attach-delete-all (&optional force) "Delete all attachments from the current outline node. This actually deletes the entire attachment directory. -A safer way is to open the directory in dired and delete from there." +A safer way is to open the directory in dired and delete from there. + +With prefix argument FORCE, directory will be recursively deleted +with no prompts." (interactive "P") (let ((attach-dir (org-attach-dir))) (when (and attach-dir (or force (yes-or-no-p "Really remove all attachments of this entry? "))) - (delete-directory attach-dir (yes-or-no-p "Recursive?") t) + (delete-directory attach-dir + (or force (yes-or-no-p "Recursive?")) + t) (message "Attachment directory removed") (run-hook-with-args 'org-attach-after-change-hook attach-dir) (org-attach-untag)))) @@ -642,37 +651,37 @@ See `org-attach-open'." Basically, this adds the path to the attachment directory." (expand-file-name file (org-attach-dir))) -(defun org-attach-expand-link (file) - "Return a file link pointing to the current entry's attachment file FILE. -Basically, this adds the path to the attachment directory, and a \"file:\" -prefix." - (concat "file:" (org-attach-expand file))) +(defun org-attach-expand-links (_) + "Expand links in current buffer. +It is meant to be added to `org-export-before-parsing-hook'." + (save-excursion + (while (re-search-forward "attachment:" nil t) + (let ((link (org-element-context))) + (when (and (eq 'link (org-element-type link)) + (string-equal "attachment" + (org-element-property :type link))) + (let* ((description (and (org-element-property :contents-begin link) + (buffer-substring-no-properties + (org-element-property :contents-begin link) + (org-element-property :contents-end link)))) + (file (org-element-property :path link)) + (new-link (org-link-make-string + (concat "file:" (org-attach-expand file)) + description))) + (goto-char (org-element-property :end link)) + (skip-chars-backward " \t") + (delete-region (org-element-property :begin link) (point)) + (insert new-link))))))) + +(defun org-attach-follow (file arg) + "Open FILE attachment. +See `org-open-file' for details about ARG." + (org-link-open-as-file (org-attach-expand file) arg)) (org-link-set-parameters "attachment" - :follow #'org-attach-open-link - :export #'org-attach-export-link + :follow #'org-attach-follow :complete #'org-attach-complete-link) -(defun org-attach-open-link (link &optional in-emacs) - "Attachment link type LINK is expanded with the attached directory and opened. - -With optional prefix argument IN-EMACS, Emacs will visit the file. -With a double \\[universal-argument] \\[universal-argument] \ -prefix arg, Org tries to avoid opening in Emacs -and to use an external application to visit the file." - (interactive "P") - (let (line search) - (cond - ((string-match "::\\([0-9]+\\)\\'" link) - (setq line (string-to-number (match-string 1 link)) - link (substring link 0 (match-beginning 0)))) - ((string-match "::\\(.+\\)\\'" link) - (setq search (match-string 1 link) - link (substring link 0 (match-beginning 0))))) - (if (string-match "[*?{]" (file-name-nondirectory link)) - (dired (org-attach-expand link)) - (org-open-file (org-attach-expand link) in-emacs line search)))) - (defun org-attach-complete-link () "Advise the user with the available files in the attachment directory." (let ((attach-dir (org-attach-dir))) @@ -691,26 +700,6 @@ and to use an external application to visit the file." (t (concat "attachment:" file)))) (error "No attachment directory exist")))) -(defun org-attach-export-link (link description format) - "Translate attachment LINK from Org mode format to exported FORMAT. -Also includes the DESCRIPTION of the link in the export." - (save-excursion - (let (path desc) - (cond - ((string-match "::\\([0-9]+\\)\\'" link) - (setq link (substring link 0 (match-beginning 0)))) - ((string-match "::\\(.+\\)\\'" link) - (setq link (substring link 0 (match-beginning 0))))) - (setq path (file-relative-name (org-attach-expand link)) - desc (or description link)) - (pcase format - (`html (format "%s" path desc)) - (`latex (format "\\href{%s}{%s}" path desc)) - (`texinfo (format "@uref{%s,%s}" path desc)) - (`ascii (format "%s (%s)" desc path)) - (`md (format "[%s](%s)" desc path)) - (_ path))))) - (defun org-attach-archive-delete-maybe () "Maybe delete subtree attachments when archiving. This function is called by `org-archive-hook'. The option @@ -758,6 +747,7 @@ Idea taken from `gnus-dired-attach'." (add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) +(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links) (provide 'org-attach) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 003cbef1fdf..a9a1181935c 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -49,11 +49,13 @@ (require 'cl-lib) (require 'org) +(require 'org-refile) (declare-function org-at-encrypted-entry-p "org-crypt" ()) (declare-function org-at-table-p "org-table" (&optional table-type)) (declare-function org-clock-update-mode-line "org-clock" (&optional refresh)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) +(declare-function org-datetree-find-month-create (d &optional keep-restriction)) (declare-function org-decrypt-entry "org-crypt" ()) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-lineage "org-element" (datum &optional types with-self)) @@ -68,6 +70,7 @@ (defvar dired-buffers) (defvar org-end-time-was-given) +(defvar org-keyword-properties) (defvar org-remember-default-headline) (defvar org-remember-templates) (defvar org-store-link-plist) @@ -156,14 +159,20 @@ description A short string describing the template, will be shown during type The type of entry. Valid types are: entry an Org node, with a headline. Will be filed as the child of the target entry or as a - top-level entry. + top-level entry. Its default template is: + \"* %?\n %a\" item a plain list item, will be placed in the - first plain list at the target - location. + first plain list at the target location. + Its default template is: + \"- %?\" checkitem a checkbox item. This differs from the plain list item only in so far as it uses a - different default template. + different default template. Its default + template is: + \"- [ ] %?\" table-line a new line in the first table at target location. + Its default template is: + \"| %? |\" plain text to be inserted as it is. target Specification of where the captured item should be placed. @@ -211,9 +220,10 @@ target Specification of where the captured item should be placed. 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 - for more details. Instead of a string, this may also be one of +template The template for creating the capture item. + If it is an empty string or nil, a default template based on + the entry type will be used (see the \"type\" section above). + Instead of a string, this may also be one of: (file \"/path/to/template-file\") (function function-returning-the-template) @@ -236,15 +246,15 @@ properties are: :jump-to-captured When set, jump to the captured entry when finished. - :empty-lines Set this to the number of lines the should be inserted + :empty-lines Set this to the number of lines that should be inserted before and after the new item. Default 0, only common other value is 1. - :empty-lines-before Set this to the number of lines the should be inserted + :empty-lines-before Set this to the number of lines that should be inserted before the new item. Overrides :empty-lines for the number lines inserted before. - :empty-lines-after Set this to the number of lines the should be inserted + :empty-lines-after Set this to the number of lines that should be inserted after the new item. Overrides :empty-lines for the number of lines inserted after. @@ -260,7 +270,9 @@ properties are: :time-prompt Prompt for a date/time to be used for date/week trees and when filling the template. - :tree-type When `week', make a week tree instead of the month tree. + :tree-type When `week', make a week tree instead of the month-day + tree. When `month', make a month tree instead of the + month-day tree. :unnarrowed Do not narrow the target buffer, simply show the full buffer. Default is to narrow it so that you @@ -322,7 +334,7 @@ be replaced with content and expanded: %^L Like %^C, but insert as link. %^{prop}p Prompt the user for a value for property `prop'. %^{prompt} Prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: + A default value and a completion table can be specified like this: %^{prompt|default|completion2|completion3|...}. %? After completing the template, position cursor here. %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N @@ -625,7 +637,7 @@ of the day at point (if any) or the current HH:MM time." (setq org-overriding-default-time (org-get-cursor-date (equal goto 1)))) (cond - ((equal goto '(4)) (org-capture-goto-target)) + ((equal goto '(4)) (org-capture-goto-target keys)) ((equal goto '(16)) (org-capture-goto-last-stored)) (t (let* ((orig-buf (current-buffer)) @@ -698,21 +710,19 @@ of the day at point (if any) or the current HH:MM time." (defun org-capture-get-template () "Get the template from a file or a function if necessary." - (let ((txt (org-capture-get :template)) file) - (cond - ((and (listp txt) (eq (car txt) 'file)) - (if (file-exists-p - (setq file (expand-file-name (nth 1 txt) org-directory))) - (setq txt (org-file-contents file)) - (setq txt (format "* Template file %s not found" (nth 1 txt))))) - ((and (listp txt) (eq (car txt) 'function)) - (if (fboundp (nth 1 txt)) - (setq txt (funcall (nth 1 txt))) - (setq txt (format "* Template function %s not found" (nth 1 txt))))) - ((not txt) (setq txt "")) - ((stringp txt)) - (t (setq txt "* Invalid capture template"))) - (org-capture-put :template txt))) + (org-capture-put + :template + (pcase (org-capture-get :template) + (`nil "") + ((and (pred stringp) template) template) + (`(file ,file) + (let ((filename (expand-file-name file org-directory))) + (if (file-exists-p filename) (org-file-contents filename) + (format "* Template file %S not found" file)))) + (`(function ,f) + (if (functionp f) (funcall f) + (format "* Template function %S not found" f))) + (_ "* Invalid capture template")))) (defun org-capture-finalize (&optional stay-with-capture) "Finalize the capture process. @@ -727,6 +737,11 @@ captured item after finalizing." (run-hooks 'org-capture-prepare-finalize-hook) + ;; Update `org-capture-plist' with the buffer-local value. Since + ;; captures can be run concurrently, this is to ensure that + ;; `org-capture-after-finalize-hook' accesses the proper plist. + (setq org-capture-plist org-capture-current-plist) + ;; Did we start the clock in this capture buffer? (when (and org-capture-clock-was-started org-clock-marker @@ -996,11 +1011,13 @@ Store them in the capture property list." (org-capture-put-target-region-and-position) (widen) ;; Make a date/week tree entry, with the current date (or - ;; yesterday, if we are extending dates for a couple of hours) + ;; yesterday, if we are extending dates for a couple of + ;; hours) (funcall - (if (eq (org-capture-get :tree-type) 'week) - #'org-datetree-find-iso-week-create - #'org-datetree-find-date-create) + (pcase (org-capture-get :tree-type) + (`week #'org-datetree-find-iso-week-create) + (`month #'org-datetree-find-month-create) + (_ #'org-datetree-find-date-create)) (calendar-gregorian-from-absolute (cond (org-overriding-default-time @@ -1021,7 +1038,7 @@ Store them in the capture property list." (apply #'encode-time 0 0 org-extend-today-until (cl-cdddr (decode-time prompt-time)))) - ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" + ((string-match "\\([^ ]+\\)-[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) ;; Replace any time range by its start. (apply #'encode-time @@ -1058,7 +1075,7 @@ Store them in the capture property list." (org-capture-put-target-region-and-position) (widen) (goto-char org-clock-hd-marker)) - (error "No running clock that could be used as capture target"))) + (user-error "No running clock that could be used as capture target"))) (target (error "Invalid capture target specification: %S" target))) (org-capture-put :buffer (current-buffer) @@ -1115,8 +1132,8 @@ may have been stored before." (`plain (org-capture-place-plain-text)) (`item (org-capture-place-item)) (`checkitem (org-capture-place-item))) - (org-capture-mode 1) - (setq-local org-capture-current-plist org-capture-plist)) + (setq-local org-capture-current-plist org-capture-plist) + (org-capture-mode 1)) (defun org-capture-place-entry () "Place the template as a new Org entry." @@ -1129,7 +1146,14 @@ may have been stored before." (when exact-position (goto-char exact-position)) (cond ;; Force insertion at point. - ((org-capture-get :insert-here) nil) + (insert-here? + ;; FIXME: level should probably set directly within (let ...). + (setq level (org-get-valid-level + (if (or (org-at-heading-p) + (ignore-errors + (save-excursion (org-back-to-heading t)))) + (org-outline-level) + 1)))) ;; Insert as a child of the current entry. ((org-capture-get :target-entry-p) (setq level (org-get-valid-level @@ -1150,14 +1174,11 @@ may have been stored before." (when insert-here? (narrow-to-region beg beg)) (org-paste-subtree level template 'for-yank)) (org-capture-position-for-last-stored beg) - (let ((end (if (org-at-heading-p) (line-end-position 0) (point)))) - (org-capture-empty-lines-after) - (unless (org-at-heading-p) (outline-next-heading)) - (org-capture-mark-kill-region origin (point)) - (org-capture-narrow beg end) - (when (or (search-backward "%?" beg t) - (search-forward "%?" end t)) - (replace-match ""))))))) + (org-capture-empty-lines-after) + (unless (org-at-heading-p) (outline-next-heading)) + (org-capture-mark-kill-region origin (point)) + (org-capture-narrow beg (if (eobp) (point) (1- (point)))) + (org-capture--position-cursor beg (point)))))) (defun org-capture-place-item () "Place the template as a new plain list item." @@ -1269,9 +1290,7 @@ may have been stored before." ;; not narrow at the beginning of the next line, possibly ;; altering its structure (e.g., when it is a headline). (org-capture-narrow beg (1- end)) - (when (or (search-backward "%?" beg t) - (search-forward "%?" end t)) - (replace-match "")))))) + (org-capture--position-cursor beg end))))) (defun org-capture-place-table-line () "Place the template as a table line." @@ -1353,9 +1372,7 @@ may have been stored before." ;; TEXT is guaranteed to end with a newline character. Ignore ;; it when narrowing so as to not alter data on the next line. (org-capture-narrow beg (1- end)) - (when (or (search-backward "%?" beg t) - (search-forward "%?" end t)) - (replace-match "")))))) + (org-capture--position-cursor beg (1- end)))))) (defun org-capture-place-plain-text () "Place the template plainly. @@ -1390,9 +1407,7 @@ Of course, if exact position has been required, just put it there." (org-capture-empty-lines-after) (org-capture-mark-kill-region origin (point)) (org-capture-narrow beg end) - (when (or (search-backward "%?" beg t) - (search-forward "%?" end t)) - (replace-match "")))))) + (org-capture--position-cursor beg end))))) (defun org-capture-mark-kill-region (beg end) "Mark the region that will have to be killed when aborting capture." @@ -1438,8 +1453,15 @@ Of course, if exact position has been required, just put it there." (defun org-capture-narrow (beg end) "Narrow, unless configuration says not to narrow." (unless (org-capture-get :unnarrowed) - (narrow-to-region beg end) - (goto-char beg))) + (narrow-to-region beg end))) + +(defun org-capture--position-cursor (beg end) + "Move point to first \"%?\" location or at start of template. +BEG and END are buffer positions at the beginning and end position +of the template." + (goto-char beg) + (when (search-forward "%?" end t) + (replace-match ""))) (defun org-capture-empty-lines-before (&optional n) "Set the correct number of empty lines before the insertion point. @@ -1736,11 +1758,11 @@ The template may still contain \"%?\" for cursor positioning." (_ (error "Invalid `org-capture--clipboards' value: %S" org-capture--clipboards))))) ("p" - ;; We remove file properties inherited from + ;; We remove keyword properties inherited from ;; target buffer so `org-read-property-value' has ;; a chance to find allowed values in sub-trees ;; from the target buffer. - (setq-local org-file-properties nil) + (setq-local org-keyword-properties nil) (let* ((origin (set-marker (make-marker) (org-capture-get :pos) (org-capture-get :buffer))) @@ -1925,4 +1947,8 @@ Assume sexps have been marked with (provide 'org-capture) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-capture.el ends here diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 06df2d49719..9efd99be826 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -35,11 +35,17 @@ (declare-function notifications-notify "notifications" (&rest params)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(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-link-display-format "ol" (s)) (declare-function org-link-heading-search-string "ol" (&optional string)) (declare-function org-link-make-string "ol" (link &optional description)) (declare-function org-table-goto-line "org-table" (n)) (declare-function org-dynamic-block-define "org" (type func)) +(declare-function w32-notification-notify "w32fns.c" (&rest params)) +(declare-function w32-notification-close "w32fns.c" (&rest params)) (defvar org-frame-title-format-backup nil) (defvar org-state) @@ -273,6 +279,15 @@ also using the face `org-mode-line-clock-overrun'." (const :tag "Just mark the time string" nil) (string :tag "Text to prepend"))) +(defcustom org-show-notification-timeout 3 + "Number of seconds to wait before closing Org notifications. +This is applied to notifications sent with `notifications-notify' +and `w32-notification-notify' only, not other mechanisms possibly +set through `org-show-notification-handler'." + :group 'org-clock + :package-version '(Org . "9.4") + :type 'integer) + (defcustom org-show-notification-handler nil "Function or program to send notification with. The function or program will be called with the notification @@ -457,6 +472,19 @@ Valid values are: `today', `yesterday', `thisweek', `lastweek', (const :tag "Select range interactively" interactive)) :safe #'symbolp) +(defcustom org-clock-auto-clockout-timer nil + "Timer for auto clocking out when Emacs is idle. +When set to a number, auto clock out the currently clocked in +task after this number of seconds of idle time. + +This is only effective when `org-clock-auto-clockout-insinuate' +is added to the user configuration." + :group 'org-clock + :package-version '(Org . "9.4") + :type '(choice + (integer :tag "Clock out after Emacs is idle for X seconds") + (const :tag "Never auto clock out" nil))) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -698,7 +726,8 @@ If not, show simply the clocked time like 01:50." (save-excursion (let ((end (save-excursion (org-end-of-subtree)))) (when (re-search-forward (concat org-clock-string - ".*\\]--\\(\\[[^]]+\\]\\)") end t) + ".*\\]--\\(\\[[^]]+\\]\\)") + end t) (org-time-string-to-time (match-string 1)))))) (defun org-clock-update-mode-line (&optional refresh) @@ -725,7 +754,8 @@ menu\nmouse-2 will jump to task")) (setq org-mode-line-string (concat (propertize org-clock-task-overrun-text - 'face 'org-mode-line-clock-overrun) org-mode-line-string))) + 'face 'org-mode-line-clock-overrun) + org-mode-line-string))) (force-mode-line-update)) (defun org-clock-get-clocked-time () @@ -808,15 +838,26 @@ If PLAY-SOUND is non-nil, it overrides `org-clock-sound'." "Show notification. Use `org-show-notification-handler' if defined, use libnotify if available, or fall back on a message." + (ignore-errors (require 'notifications)) (cond ((functionp org-show-notification-handler) (funcall org-show-notification-handler notification)) ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) + ((fboundp 'w32-notification-notify) + (let ((id (w32-notification-notify + :title "Org mode message" + :body notification + :urgency 'low))) + (run-with-timer + org-show-notification-timeout + nil + (lambda () (w32-notification-close id))))) ((fboundp 'notifications-notify) (notifications-notify :title "Org mode message" :body notification + :timeout (* org-show-notification-timeout 1000) ;; FIXME how to link to the Org icon? ;; :app-icon "~/.emacs.d/icons/mail.png" :urgency 'low)) @@ -859,7 +900,8 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." (goto-char (point-min)) (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)))) + (org-time-string-to-time (match-string 1))) + clocks)))) clocks)) (defsubst org-is-active-clock (clock) @@ -983,7 +1025,7 @@ CLOCK is a cons cell of the form (MARKER START-TIME)." (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)) + (org-hide-drawer-toggle 'off nil element)) (throw 'exit nil))))))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) @@ -1022,6 +1064,9 @@ 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. +t/T Like `k', but will ask you to specify a time (when you got + distracted away), instead of a number of minutes. + 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. @@ -1041,19 +1086,24 @@ to be CLOCKED OUT.")))) (while (or (null char-pressed) (and (not (memq char-pressed '(?k ?K ?g ?G ?s ?S ?C - ?j ?J ?i ?q))) + ?j ?J ?i ?q ?t ?T))) (or (ding) t))) (setq char-pressed (read-char (concat (funcall prompt-fn clock) - " [jkKgGSscCiq]? ") + " [jkKtTgGSscCiq]? ") nil 45))) (and (not (memq char-pressed '(?i ?q))) char-pressed))))) (default (floor (org-time-convert-to-integer (org-time-since last-valid)) 60)) (keep - (and (memq ch '(?k ?K)) - (read-number "Keep how many minutes? " default))) + (or (and (memq ch '(?k ?K)) + (read-number "Keep how many minutes? " default)) + (and (memq ch '(?t ?T)) + (floor + (/ (float-time + (org-time-subtract (org-read-date t t) last-valid)) + 60))))) (gotback (and (memq ch '(?g ?G)) (read-number "Got back how many minutes ago? " default))) @@ -1068,7 +1118,7 @@ to be CLOCKED OUT.")))) (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) (org-clock-jump-to-current-clock clock)) ((or (null ch) - (not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) + (not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T)))) (message "")) (t (org-clock-resolve-clock @@ -1092,7 +1142,7 @@ to be CLOCKED OUT.")))) (t (error "Unexpected, please report this as a bug"))) (and gotback last-valid) - (memq ch '(?K ?G ?S)) + (memq ch '(?K ?G ?S ?T)) (and start-over (not (memq ch '(?K ?G ?S ?C)))) fail-quietly))))) @@ -1315,7 +1365,6 @@ the default behavior." (t (insert-before-markers "\n") (backward-char 1) - (org-indent-line) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) @@ -1340,7 +1389,8 @@ the default behavior." start-time (org-current-time org-clock-rounding-minutes t))) (setq ts (org-insert-time-stamp org-clock-start-time - 'with-hm 'inactive)))) + 'with-hm 'inactive)) + (org-indent-line))) (move-marker org-clock-marker (point) (buffer-base-buffer)) (move-marker org-clock-hd-marker (save-excursion (org-back-to-heading t) (point)) @@ -1375,6 +1425,26 @@ the default behavior." (message "Clock starts at %s - %s" ts org--msg-extra) (run-hooks 'org-clock-in-hook)))))) +(defun org-clock-auto-clockout () + "Clock out the currently clocked in task if Emacs is idle. +See `org-clock-auto-clockout-timer' to set the idle time span. + +This is only effective when `org-clock-auto-clockout-insinuate' +is present in the user configuration." + (when (and (numberp org-clock-auto-clockout-timer) + org-clock-current-task) + (run-with-idle-timer + org-clock-auto-clockout-timer nil #'org-clock-out))) + +;;;###autoload +(defun org-clock-toggle-auto-clockout () + (interactive) + (if (memq 'org-clock-auto-clockout org-clock-in-hook) + (progn (remove-hook 'org-clock-in-hook #'org-clock-auto-clockout) + (message "Auto clock-out after idle time turned off")) + (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t) + (message "Auto clock-out after idle time turned on"))) + ;;;###autoload (defun org-clock-in-last (&optional arg) "Clock in the last closed clocked item. @@ -1512,7 +1582,7 @@ line and position cursor in that line." (insert ":" drawer ":\n:END:\n") (org-indent-region beg (point)) (org-flag-region - (line-end-position -1) (1- (point)) t 'org-hide-drawer) + (line-end-position -1) (1- (point)) t 'outline) (forward-line -1)))) ;; When a clock drawer needs to be created because of the ;; number of clock items or simply if it is missing, collect @@ -1537,7 +1607,7 @@ line and position cursor in that line." (let ((end (point-marker))) (goto-char beg) (save-excursion (insert ":" drawer ":\n")) - (org-flag-region (line-end-position) (1- end) t 'org-hide-drawer) + (org-flag-region (line-end-position) (1- end) t 'outline) (org-indent-region (point) end) (forward-line) (unless org-log-states-order-reversed @@ -1579,7 +1649,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." org-clock-out-switch-to-state)) (now (org-current-time org-clock-rounding-minutes)) ts te s h m remove) - (setq org-clock-out-time now) + (setq org-clock-out-time (or at-time now)) (save-excursion ; Do not replace this with `with-current-buffer'. (with-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction @@ -1724,7 +1794,7 @@ Optional argument N tells to change by that many units." (delq 'org-mode-line-string global-mode-string)) (org-clock-restore-frame-title-format) (force-mode-line-update) - (error "No active clock")) + (user-error "No active clock")) (save-excursion ; Do not replace this with `with-current-buffer'. (with-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) @@ -1753,14 +1823,14 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (m (cond (select (or (org-clock-select-task "Select task to go to: ") - (error "No task selected"))) + (user-error "No task selected"))) ((org-clocking-p) org-clock-marker) ((and org-clock-goto-may-find-recent-task (car org-clock-history) (marker-buffer (car org-clock-history))) (setq recent t) (car org-clock-history)) - (t (error "No active or recent clock task"))))) + (t (user-error "No active or recent clock task"))))) (pop-to-buffer-same-window (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) @@ -1890,7 +1960,12 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." "Return time, clocked on current item in total." (save-excursion (save-restriction - (org-narrow-to-subtree) + (if (and (featurep 'org-inlinetask) + (or (org-inlinetask-at-task-p) + (org-inlinetask-in-task-p))) + (narrow-to-region (save-excursion (org-inlinetask-goto-beginning) (point)) + (save-excursion (org-inlinetask-goto-end) (point))) + (org-narrow-to-subtree)) (org-clock-sum tstart) org-clock-file-total-minutes))) @@ -2067,7 +2142,10 @@ in the buffer and update it." (start (goto-char start))) (org-update-dblock)) -(org-dynamic-block-define "clocktable" #'org-clock-report) +;;;###autoload +(eval-after-load 'org + '(progn + (org-dynamic-block-define "clocktable" #'org-clock-report))) (defun org-day-of-week (day month year) "Return the day of the week as an integer." @@ -2310,7 +2388,7 @@ the currently selected interval size." (save-excursion (goto-char (point-at-bol)) (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) - (error "Line needs a :block definition before this command works") + (user-error "Line needs a :block definition before this command works") (let* ((b (match-beginning 1)) (e (match-end 1)) (s (match-string 1)) block shift ins y mw d date wp m) @@ -2369,7 +2447,7 @@ the currently selected interval size." (encode-time 0 0 0 1 (+ mw n) y)))) (y (setq ins (number-to-string (+ y n)))))) - (t (error "Cannot shift clocktable block"))) + (t (user-error "Cannot shift clocktable block"))) (when ins (goto-char b) (insert ins) @@ -2384,20 +2462,21 @@ the currently selected interval size." (setq params (org-combine-plists org-clocktable-defaults params)) (catch 'exit (let* ((scope (plist-get params :scope)) + (base-buffer (org-base-buffer (current-buffer))) (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)))) + (let ((base-file (buffer-file-name base-buffer))) + (and base-file + (org-add-archive-files (list base-file))))) ((or `nil `file `subtree `tree (and (pred symbolp) (guard (string-match "\\`tree\\([0-9]+\\)\\'" (symbol-name scope))))) - (or (buffer-file-name (buffer-base-buffer)) - (current-buffer))) + base-buffer) ((pred functionp) (funcall scope)) ((pred consp) scope) (_ (user-error "Unknown scope: %S" scope)))) @@ -2421,7 +2500,7 @@ the currently selected interval size." (when step ;; Write many tables, in steps (unless (or block (and ts te)) - (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'")) + (user-error "Clocktable `:step' can only be used with `:block' or `:tstart, :end'")) (org-clocktable-steps params) (throw 'exit nil)) @@ -2527,7 +2606,7 @@ from the dynamic block definition." (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow)))) (setq narrow-cut-p t) (setq narrow (string-to-number (symbol-name narrow)))) - (_ (error "Invalid value %s of :narrow property in clock table" narrow))) + (_ (user-error "Invalid value %s of :narrow property in clock table" narrow))) ;; Now we need to output this table stuff. (goto-char ipos) @@ -2718,6 +2797,7 @@ a number of clock tables." (pcase step (`day "Daily report: ") (`week "Weekly report starting on: ") + (`semimonth "Semimonthly report starting on: ") (`month "Monthly report starting on: ") (`year "Annual report starting on: ") (_ (user-error "Unknown `:step' specification: %S" step)))) @@ -2767,6 +2847,9 @@ a number of clock tables." (let ((offset (if (= dow week-start) 7 (mod (- week-start dow) 7)))) (list 0 0 org-extend-today-until (+ d offset) m y))) + (`semimonth (list 0 0 0 + (if (< d 16) 16 1) + (if (< d 16) m (1+ m)) y)) (`month (list 0 0 0 month-start (1+ m) y)) (`year (list 0 0 org-extend-today-until 1 1 (1+ y))))))) (table-begin (line-beginning-position 0)) @@ -2883,7 +2966,7 @@ PROPERTIES: The list properties specified in the `:properties' parameter (org-trim (org-link-display-format (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" headline))))))) (tgs (and tags (org-get-tags))) (tsp diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index e967154abbc..565bdb2ddee 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -44,6 +44,8 @@ (declare-function org-dynamic-block-define "org" (type func)) (declare-function org-link-display-format "ol" (s)) (declare-function org-link-open-from-string "ol" (s &optional arg)) +(declare-function face-remap-remove-relative "face-remap" (cookie)) +(declare-function face-remap-add-relative "face-remap" (face &rest specs)) (defvar org-agenda-columns-add-appointments-to-effort-sum) (defvar org-agenda-columns-compute-summary-properties) @@ -164,7 +166,7 @@ See `org-columns-summary-types' for details.") (org-defkey org-columns-map "o" 'org-overview) (org-defkey org-columns-map "e" 'org-columns-edit-value) (org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo) -(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle) +(org-defkey org-columns-map "\C-c\C-c" 'org-columns-toggle-or-columns-quit) (org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link) (org-defkey org-columns-map "v" 'org-columns-show-value) (org-defkey org-columns-map "q" 'org-columns-quit) @@ -257,6 +259,8 @@ value for ITEM property." (if org-hide-leading-stars ?\s ?*)) "* ")))) (concat stars (org-link-display-format value)))) + (`(,(or "DEADLINE" "SCHEDULED" "TIMESTAMP") . ,_) + (replace-regexp-in-string org-ts-regexp "[\\1]" value)) (`(,_ ,_ ,_ ,_ nil) value) ;; If PRINTF is set, assume we are displaying a number and ;; obey to the format string. @@ -364,11 +368,18 @@ ORIGINAL is the real string, i.e., before it is modified by ("TODO" (propertize v 'face (org-get-todo-face original))) (_ v))))) +(defvar org-columns-header-line-remap nil + "Store the relative remapping of column header-line. +This is needed to later remove this relative remapping.") + (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'." + (when (ignore-errors (require 'face-remap)) + (setq org-columns-header-line-remap + (face-remap-add-relative 'header-line '(:inherit default)))) (save-excursion (beginning-of-line) (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") @@ -378,8 +389,7 @@ DATELINE is non-nil when the face used should be (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))) + (font (list :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 @@ -502,6 +512,9 @@ for the duration of the command.") (defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) + (when (and (fboundp 'face-remap-remove-relative) + org-columns-header-line-remap) + (face-remap-remove-relative org-columns-header-line-remap)) (when org-columns-overlays (when (local-variable-p 'org-previous-header-line-format) (setq header-line-format org-previous-header-line-format) @@ -554,13 +567,19 @@ for the duration of the command.") (interactive "P") (org-columns-edit-value "TODO")) -(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-]\\]\\'" - (get-char-property (point) 'org-columns-value)) - (org-columns-next-allowed-value) - (org-columns-edit-value "TAGS"))) +(defun org-columns-toggle-or-columns-quit () + "Toggle checkbox at point, or quit column view." + (interactive) + (or (org-columns--toggle) + (org-columns-quit))) + +(defun org-columns--toggle () + "Toggle checkbox at point. Return non-nil if toggle happened, else nil. +See info documentation about realizing a suitable checkbox." + (when (string-match "\\`\\[[ xX-]\\]\\'" + (get-char-property (point) 'org-columns-value)) + (org-columns-next-allowed-value) + t)) (defvar org-overriding-columns-format nil "When set, overrides any other format definition for the agenda. @@ -1550,7 +1569,10 @@ PARAMS is a property list of parameters: (id))))) (org-update-dblock)) -(org-dynamic-block-define "columnview" #'org-columns-insert-dblock) +;;;###autoload +(eval-after-load 'org + '(progn + (org-dynamic-block-define "columnview" #'org-columns-insert-dblock))) ;;; Column view in the agenda @@ -1564,6 +1586,7 @@ PARAMS is a property list of parameters: (move-marker org-columns-begin-marker (point)) (setq org-columns-begin-marker (point-marker))) (let* ((org-columns--time (float-time)) + (org-done-keywords org-done-keywords-for-agenda) (fmt (cond ((bound-and-true-p org-overriding-columns-format)) @@ -1613,6 +1636,7 @@ PARAMS is a property list of parameters: (dolist (entry cache) (goto-char (car entry)) (org-columns--display-here (cdr entry))) + (setq-local org-agenda-columns-active t) (when org-agenda-columns-show-summaries (org-agenda-colview-summarize cache))))))) @@ -1677,8 +1701,7 @@ This will add overlays to the date lines, to show the summary for each day." 'face 'bold final)) (list spec final final))))) fmt) - 'dateline) - (setq-local org-agenda-columns-active t)))) + 'dateline)))) (if (bobp) (throw :complete t) (forward-line -1))))))) (defun org-agenda-colview-compute (fmt) @@ -1704,4 +1727,8 @@ This will add overlays to the date lines, to show the summary for each day." (provide 'org-colview) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-colview.el ends here diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index c1aaf17ca2b..e4d8658197c 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -46,11 +46,13 @@ (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-tags "org" (&optional pos local)) +(declare-function org-hide-block-toggle "org" (&optional force no-error element)) (declare-function org-link-display-format "ol" (s)) (declare-function org-link-set-parameters "ol" (type &rest rest)) (declare-function org-log-into-drawer "org" ()) (declare-function org-make-tag-string "org" (tags)) (declare-function org-reduced-level "org" (l)) +(declare-function org-return "org" (&optional indent arg interactive)) (declare-function org-show-context "org" (&optional key)) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function outline-next-heading "outline" ()) @@ -101,6 +103,20 @@ is nil)." (defun org-time-convert-to-list (time) (seconds-to-time (float-time time)))) +;; `newline-and-indent' did not take a numeric argument before 27.1. +(if (version< emacs-version "27") + (defsubst org-newline-and-indent (&optional _arg) + (newline-and-indent)) + (defalias 'org-newline-and-indent #'newline-and-indent)) + +(defun org--set-faces-extend (faces extend-p) + "Set the :extend attribute of FACES to EXTEND-P. + +This is a no-op for Emacs versions lower than 27, since face +extension beyond end of line was not controllable." + (when (fboundp 'set-face-extend) + (mapc (lambda (f) (set-face-extend f extend-p)) faces))) + ;;; Emacs < 26.1 compatibility @@ -314,6 +330,8 @@ Counting starts at 1." (define-obsolete-variable-alias 'org-attach-directory 'org-attach-id-dir "Org 9.3") +(make-obsolete 'org-attach-store-link "No longer used" "Org 9.4") +(make-obsolete 'org-attach-expand-link "No longer used" "Org 9.4") (defun org-in-fixed-width-region-p () "Non-nil if point in a fixed-width region." @@ -556,6 +574,11 @@ use of this function is for the stuck project list." (define-obsolete-function-alias 'org-make-link-regexps 'org-link-make-regexps "Org 9.3") +(define-obsolete-function-alias 'org-property-global-value + 'org-property-global-or-keyword-value "Org 9.3") + +(make-obsolete-variable 'org-file-properties 'org-keyword-properties "Org 9.3") + (define-obsolete-variable-alias 'org-angle-link-re 'org-link-angle-re "Org 9.3") @@ -616,6 +639,72 @@ use of this function is for the stuck project list." (declare (obsolete "use `org-align-tags' instead." "Org 9.2")) (org-align-tags t)) +(define-obsolete-function-alias + 'org-at-property-block-p 'org-at-property-drawer-p "Org 9.4") + +(defun org-flag-drawer (flag &optional element beg end) + "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. + +When buffer positions BEG and END are provided, hide or show that +region as a drawer without further ado." + (declare (obsolete "use `org-hide-drawer-toggle' instead." "Org 9.4")) + (if (and beg end) (org-flag-region beg end flag 'outline) + (let ((drawer + (or element + (and (save-excursion + (beginning-of-line) + (looking-at-p "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$")) + (org-element-at-point))))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (let ((post (org-element-property :post-affiliated drawer))) + (org-flag-region + (save-excursion (goto-char post) (line-end-position)) + (save-excursion (goto-char (org-element-property :end drawer)) + (skip-chars-backward " \t\n") + (line-end-position)) + flag 'outline) + ;; When the drawer is hidden away, make sure point lies in + ;; a visible part of the buffer. + (when (invisible-p (max (1- (point)) (point-min))) + (goto-char post))))))) + +(defun org-hide-block-toggle-maybe () + "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." + (declare (obsolete "use `org-hide-block-toggle' instead." "Org 9.4")) + (interactive) + (org-hide-block-toggle nil t)) + +(defun org-hide-block-toggle-all () + "Toggle the visibility of all blocks in the current buffer." + (declare (obsolete "please notify Org mailing list if you use this function." + "Org 9.4")) + (let ((start (point-min)) + (end (point-max))) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward "^[ \t]*#\\+begin_?\ +\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" end t)) + (save-excursion + (save-match-data + (goto-char (match-beginning 0)) + (org-hide-block-toggle))))))) + +(defun org-return-indent () + "Goto next table row or insert a newline and indent. +Calls `org-table-next-row' or `newline-and-indent', depending on +context. See the individual commands for more information." + (declare (obsolete "use `org-return' with INDENT set to t instead." + "Org 9.4")) + (interactive) + (org-return t)) + (defmacro org-with-silent-modifications (&rest body) (declare (obsolete "use `with-silent-modifications' instead." "Org 9.2") (debug (body))) @@ -624,6 +713,23 @@ use of this function is for the stuck project list." (define-obsolete-function-alias 'org-babel-strip-quotes 'org-strip-quotes "Org 9.2") +(define-obsolete-variable-alias 'org-sort-agenda-notime-is-late + 'org-agenda-sort-notime-is-late "9.4") + +(define-obsolete-variable-alias 'org-sort-agenda-noeffort-is-high + 'org-agenda-sort-noeffort-is-high "9.4") + +(defconst org-maybe-keyword-time-regexp + (concat "\\(\\<\\(\\(?:CLO\\(?:CK\\|SED\\)\\|DEADLINE\\|SCHEDULED\\):\\)\\)?" + " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*[]>]" + "\\|" + "<%%([^\r\n>]*>\\)") + "Matches a timestamp, possibly preceded by a keyword.") +(make-obsolete-variable + 'org-maybe-keyword-time-regexp + "use `org-planning-line-re', followed by `org-ts-regexp-both' instead." + "Org 9.4") + ;;;; Obsolete link types (eval-after-load 'ol @@ -808,7 +914,7 @@ This also applied for speedbar access." (setq last-level level))))) (aref subs 1)))) -(eval-after-load "imenu" +(eval-after-load 'imenu '(progn (add-hook 'imenu-after-jump-hook (lambda () @@ -870,7 +976,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." (defvar speedbar-file-key-map) (declare-function speedbar-add-supported-extension "speedbar" (extension)) -(eval-after-load "speedbar" +(eval-after-load 'speedbar '(progn (speedbar-add-supported-extension ".org") (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) @@ -980,7 +1086,7 @@ ELEMENT is the element at point." (flyspell-delete-region-overlays beg end))) (defvar flyspell-delayed-commands) -(eval-after-load "flyspell" +(eval-after-load 'flyspell '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command)) ;;;; Bookmark @@ -994,7 +1100,7 @@ ELEMENT is the element at point." (org-show-context 'bookmark-jump))) ;; Make `bookmark-jump' shows the jump location if it was hidden. -(eval-after-load "bookmark" +(eval-after-load 'bookmark '(if (boundp 'bookmark-after-jump-hook) ;; We can use the hook (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) @@ -1043,17 +1149,18 @@ key." ((guard (not (lookup-key calendar-mode-map "c"))) (local-set-key "c" #'org-calendar-goto-agenda)) (_ nil)) - (unless (eq org-agenda-diary-file 'diary-file) + (unless (and (boundp 'org-agenda-diary-file) + (eq org-agenda-diary-file 'diary-file)) (local-set-key org-calendar-insert-diary-entry-key #'org-agenda-diary-entry))) -(eval-after-load "calendar" +(eval-after-load 'calendar '(add-hook 'calendar-mode-hook #'org--setup-calendar-bindings)) ;;;; Saveplace ;; Make sure saveplace shows the location if it was hidden -(eval-after-load "saveplace" +(eval-after-load 'saveplace '(defadvice save-place-find-file-hook (after org-make-visible activate) "Make the position visible." (org-bookmark-jump-unhide))) @@ -1061,7 +1168,7 @@ key." ;;;; Ecb ;; Make sure ecb shows the location if it was hidden -(eval-after-load "ecb" +(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." (when (derived-mode-p 'org-mode) @@ -1075,17 +1182,17 @@ key." (org-invisible-p)) (org-show-context 'mark-goto))) -(eval-after-load "simple" +(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" +(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" +(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))) @@ -1094,9 +1201,13 @@ key." ;; Make "session.el" ignore our circular variable. (defvar session-globals-exclude) -(eval-after-load "session" +(eval-after-load 'session '(add-to-list 'session-globals-exclude 'org-mark-ring)) (provide 'org-compat) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-compat.el ends here diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index 4b46a3145f4..187560c5538 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -1,14 +1,8 @@ ;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*- +;; ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. -;; Emacs Lisp Archive Entry -;; Filename: org-crypt.el -;; Keywords: org-mode ;; Author: John Wiegley -;; Maintainer: Peter Jones -;; Description: Adds public key encryption to Org buffers -;; URL: http://www.newartisans.com/software/emacs.html -;; Compatibility: Emacs22 ;; This file is part of GNU Emacs. ;; @@ -47,9 +41,7 @@ ;; ;; 3. To later decrypt an entry, use `org-decrypt-entries' or ;; `org-decrypt-entry'. It might be useful to bind this to a key, -;; like C-c C-/. I hope that in the future, C-c C-r can be might -;; overloaded to also decrypt an entry if it's encrypted, since -;; that fits nicely with the meaning of "reveal". +;; like C-c C-/. ;; ;; 4. To automatically encrypt all necessary entries when saving a ;; file, call `org-crypt-use-before-save-magic' after loading @@ -60,10 +52,11 @@ ;; - Carsten Dominik ;; - Vitaly Ostanin -(require 'org) - ;;; Code: +(require 'org-macs) +(require 'org-compat) + (declare-function epg-decrypt-string "epg" (context cipher)) (declare-function epg-list-keys "epg" (context &optional name mode)) (declare-function epg-make-context "epg" @@ -74,6 +67,17 @@ (context plain recipients &optional sign always-trust)) (defvar epg-context) +(declare-function org-back-over-empty-lines "org" ()) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-end-of-meta-data "org" (&optional full)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-flag-subtree "org" (flag)) +(declare-function org-make-tags-matcher "org" (match)) +(declare-function org-previous-visible-heading "org" (arg)) +(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level)) +(declare-function org-set-property "org" (property value)) (defgroup org-crypt nil "Org Crypt." @@ -90,9 +94,18 @@ See the \"Match syntax\" section of the org manual for more details." (defcustom org-crypt-key "" "The default key to use when encrypting the contents of a heading. -This setting can also be overridden in the CRYPTKEY property." - :type 'string - :group 'org-crypt) +If this variable is nil, always use symmetric encryption, unconditionally. + +Otherwise, The string is matched against all keys in the key ring. +In particular, the empty string matches no key. If no key is found, +look for the `epa-file-encrypt-to' local variable. Ultimately fall back +to symmetric encryption. + +This setting can be overridden in the CRYPTKEY property." + :group 'org-crypt + :type '(choice + (string :tag "Public key(s) matching") + (const :tag "Symmetric encryption" nil))) (defcustom org-crypt-disable-auto-save 'ask "What org-decrypt should do if `auto-save-mode' is enabled. @@ -118,6 +131,36 @@ nil : Leave auto-save-mode enabled. (const :tag "Ask" ask) (const :tag "Encrypt" encrypt))) +(defun org-crypt--encrypted-text (beg end) + "Return encrypted text in between BEG and END." + ;; Ignore indentation. + (replace-regexp-in-string + "^[ \t]*" "" + (buffer-substring-no-properties beg end))) + +(defun org-at-encrypted-entry-p () + "Is the current entry encrypted? +When the entry is encrypted, return a pair (BEG . END) where BEG +and END are buffer positions delimiting the encrypted area." + (org-with-wide-buffer + (unless (org-before-first-heading-p) + (org-back-to-heading t) + (org-end-of-meta-data 'standard) + (let ((case-fold-search nil) + (banner-start (rx (seq bol + (zero-or-more (any "\t ")) + "-----BEGIN PGP MESSAGE-----" + eol)))) + (when (looking-at banner-start) + (let ((start (point)) + (banner-end (rx (seq bol + (or (group (zero-or-more (any "\t ")) + "-----END PGP MESSAGE-----" + eol) + (seq (one-or-more "*") " ")))))) + (when (and (re-search-forward banner-end nil t) (match-string 1)) + (cons start (line-beginning-position 2))))))))) + (defun org-crypt-check-auto-save () "Check whether auto-save-mode is enabled for the current buffer. @@ -149,93 +192,99 @@ See `org-crypt-disable-auto-save'." (t nil)))) (defun org-crypt-key-for-heading () - "Return the encryption key for the current heading." - (save-excursion - (org-back-to-heading t) - (or (org-entry-get nil "CRYPTKEY" 'selective) - org-crypt-key - (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) - (message "No crypt key set, using symmetric encryption.")))) - -(defun org-encrypt-string (str crypt-key) - "Return STR encrypted with CRYPT-KEY." - ;; Text and key have to be identical, otherwise we re-crypt. - (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) - (setq-local epg-context (epg-make-context nil t t)) - (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))) + "Return the encryption key(s) for the current heading. +Assume `epg-context' is set." + (and org-crypt-key + (or (epg-list-keys epg-context + (or (org-entry-get nil "CRYPTKEY" 'selective) + org-crypt-key)) + (bound-and-true-p epa-file-encrypt-to) + (progn + (message "No crypt key set, using symmetric encryption.") + nil)))) +;;;###autoload (defun org-encrypt-entry () "Encrypt the content of the current headline." (interactive) - (require 'epg) - (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))) + (unless (org-at-encrypted-entry-p) + (require 'epg) + (setq-local epg-context (epg-make-context nil t t)) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((start-heading (point)) + (crypt-key (org-crypt-key-for-heading)) + (folded? (org-invisible-p (line-beginning-position)))) + (org-end-of-meta-data 'standard) + (let ((beg (point)) + (folded-heading + (and folded? + (save-excursion + (org-previous-visible-heading 1) + (point))))) (goto-char start-heading) (org-end-of-subtree t t) (org-back-over-empty-lines) - (let ((contents (delete-and-extract-region beg (point)))) + (let* ((contents (delete-and-extract-region beg (point))) + (key (get-text-property 0 'org-crypt-key contents)) + (checksum (get-text-property 0 'org-crypt-checksum contents))) (condition-case err - (insert (org-encrypt-string contents crypt-key)) + (insert + ;; Text and key have to be identical, otherwise we + ;; re-crypt. + (if (and (equal crypt-key key) + (string= checksum (sha1 contents))) + (get-text-property 0 'org-crypt-text contents) + (epg-encrypt-string epg-context 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) + (error + (insert contents) + (error (error-message-string err))))) + (when folded-heading + (goto-char folded-heading) (org-flag-subtree t)) nil))))) +;;;###autoload (defun org-decrypt-entry () "Decrypt the content of the current headline." (interactive) - (require 'epg) - (unless (org-before-first-heading-p) - (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)))))) + (pcase (org-at-encrypted-entry-p) + (`(,beg . ,end) + (require 'epg) + (setq-local epg-context (epg-make-context nil t t)) + (org-with-point-at beg + (org-crypt-check-auto-save) + (let* ((folded-heading + (and (org-invisible-p) + (save-excursion + (org-previous-visible-heading 1) + (point)))) + (encrypted-text (org-crypt--encrypted-text beg 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 folded-heading + (goto-char folded-heading) + (org-flag-subtree t)) + nil))) + (_ nil))) +;;;###autoload (defun org-encrypt-entries () "Encrypt all top-level entries in the current buffer." (interactive) @@ -245,6 +294,7 @@ See `org-crypt-disable-auto-save'." (cdr (org-make-tags-matcher org-crypt-tag-matcher)) org--matcher-tags-todo-only))) +;;;###autoload (defun org-decrypt-entries () "Decrypt all entries in the current buffer." (interactive) @@ -254,14 +304,7 @@ See `org-crypt-disable-auto-save'." (cdr (org-make-tags-matcher org-crypt-tag-matcher)) org--matcher-tags-todo-only))) -(defun org-at-encrypted-entry-p () - "Is the current entry encrypted?" - (unless (org-before-first-heading-p) - (save-excursion - (org-back-to-heading t) - (search-forward "-----BEGIN PGP MESSAGE-----" - (save-excursion (outline-next-heading)) t)))) - +;;;###autoload (defun org-crypt-use-before-save-magic () "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 6469abef794..d4ccc84bb4b 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -51,11 +51,29 @@ Added time stamp is active unless value is `inactive'." ;;;###autoload (defun org-datetree-find-date-create (d &optional keep-restriction) - "Find or create an entry for date D. + "Find or create a day 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. If it is the symbol `subtree-at-point', then the tree will be built under the headline at point." + (org-datetree--find-create-group d 'day keep-restriction)) + +;;;###autoload +(defun org-datetree-find-month-create (d &optional keep-restriction) + "Find or create a month entry for date D. +Compared to `org-datetree-find-date-create' this function creates +entries grouped by month instead of days. +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. If it is the symbol `subtree-at-point', then the tree +will be built under the headline at point." + (org-datetree--find-create-group d 'month keep-restriction)) + +(defun org-datetree--find-create-group + (d time-grouping &optional keep-restriction) + "Find or create an entry for date D. +If time-period is day, group entries by day. If time-period is +month, then group entries by month." (setq-local org-datetree-base-level 1) (save-restriction (if (eq keep-restriction 'subtree-at-point) @@ -84,9 +102,10 @@ will be built under the headline at point." (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)))) + (when (eq time-grouping 'day) + (org-datetree--find-create + "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" + year month day))))) ;;;###autoload (defun org-datetree-find-iso-week-create (d &optional keep-restriction) @@ -166,6 +185,8 @@ inserted into the buffer." (defun org-datetree-insert-line (year &optional month day text) (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) + (when (assq 'heading org-blank-before-new-entry) + (insert "\n")) (insert "\n" (make-string org-datetree-base-level ?*) " \n") (backward-char) (when month (org-do-demote)) diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el index 155bfae6ca0..81d5a66d9c8 100644 --- a/lisp/org/org-duration.el +++ b/lisp/org/org-duration.el @@ -28,14 +28,16 @@ ;; - 3:12 ;; - 1:23:45 ;; - 1y 3d 3h 4min +;; - 1d3h5min ;; - 3d 13:35 ;; - 2.35h ;; ;; More accurately, it consists of numbers and units, as defined in -;; variable `org-duration-units', separated with white spaces, and -;; a "H:MM" or "H:MM:SS" part. White spaces are tolerated between the -;; number and its relative unit. Variable `org-duration-format' -;; controls durations default representation. +;; variable `org-duration-units', possibly separated with white +;; spaces, and an optional "H:MM" or "H:MM:SS" part, which always +;; comes last. White spaces are tolerated between the number and its +;; relative unit. Variable `org-duration-format' controls durations +;; default representation. ;; ;; The library provides functions allowing to convert a duration to, ;; and from, a number of minutes: `org-duration-to-minutes' and @@ -122,8 +124,7 @@ are specified here. Units with a zero value are skipped, unless REQUIRED? is non-nil. In that case, the unit is always used. -Eventually, the list can contain one of the following special -entries: +The list can also contain one of the following special entries: (special . h:mm) (special . h:mm:ss) @@ -139,6 +140,10 @@ entries: first one required or with a non-zero integer part. If there is no such unit, the smallest one is used. +Eventually, if the list contains the symbol `compact', the +duration is expressed in a compact form, without any white space +between units. + For example, ((\"d\" . nil) (\"h\" . t) (\"min\" . t)) @@ -172,7 +177,6 @@ a 2-digits fractional part, of \"d\" unit. A duration shorter than a day uses \"h\" unit instead." :group 'org-time :group 'org-clock - :version "26.1" :package-version '(Org . "9.1") :type '(choice (const :tag "Use H:MM" h:mm) @@ -191,7 +195,8 @@ than a day uses \"h\" unit instead." (const h:mm)) (cons :tag "Use both units and H:MM:SS" (const special) - (const h:mm:ss)))))) + (const h:mm:ss)) + (const :tag "Use compact form" compact))))) ;;; Internal variables and functions @@ -249,13 +254,10 @@ When optional argument CANONICAL is non-nil, refer to org-duration-units)) t))) (setq org-duration--full-re - (format "\\`[ \t]*%s\\(?:[ \t]+%s\\)*[ \t]*\\'" - org-duration--unit-re - org-duration--unit-re)) + (format "\\`\\(?:[ \t]*%s\\)+[ \t]*\\'" org-duration--unit-re)) (setq org-duration--mixed-re - (format "\\`[ \t]*\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\ + (format "\\`\\(?1:\\([ \t]*%s\\)+\\)[ \t]*\ \\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'" - org-duration--unit-re org-duration--unit-re))) ;;;###autoload @@ -353,10 +355,11 @@ Raise an error if expected format is unknown." ;; Represent minutes above hour using provided units and H:MM ;; or H:MM:SS below. (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier))) - (minutes-part (- minutes units-part))) + (minutes-part (- minutes units-part)) + (compact (memq 'compact duration-format))) (concat (org-duration-from-minutes units-part truncated-format canonical) - " " + (and (not compact) " ") (org-duration-from-minutes minutes-part mode)))))) ;; Units format. (duration-format @@ -368,12 +371,16 @@ Raise an error if expected format is unknown." (format "%%.%df" digits)))) (selected-units (sort (cl-remove-if - ;; Ignore special format cells. - (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil))) + ;; Ignore special format cells and compact option. + (lambda (pair) + (pcase pair + ((or `compact `(special . ,_)) t) + (_ nil))) duration-format) (lambda (a b) (> (org-duration--modifier (car a) canonical) - (org-duration--modifier (car b) canonical)))))) + (org-duration--modifier (car b) canonical))))) + (separator (if (memq 'compact duration-format) "" " "))) (cond ;; Fractional duration: use first unit that is either required ;; or smaller than MINUTES. @@ -402,8 +409,8 @@ Raise an error if expected format is unknown." (cond ((<= modifier minutes) (let ((value (floor minutes modifier))) (cl-decf minutes (* value modifier)) - (format " %d%s" value unit))) - (required? (concat " 0" unit)) + (format "%s%d%s" separator value unit))) + (required? (concat separator "0" unit)) (t "")))) selected-units "")))) @@ -441,4 +448,9 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return (org-duration-set-regexps) (provide 'org-duration) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-duration.el ends here diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 4b5f9a19e6d..2ad557d2179 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -72,7 +72,6 @@ (declare-function org-at-heading-p "org" (&optional _)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-escape-code-in-string "org-src" (s)) -(declare-function org-find-visible "org" ()) (declare-function org-macro-escape-arguments "org-macro" (&rest args)) (declare-function org-macro-extract-arguments "org-macro" (s)) (declare-function org-reduced-level "org" (l)) @@ -330,7 +329,9 @@ match group 2. Don't modify it, set `org-element-affiliated-keywords' instead.") (defconst org-element-object-restrictions - (let* ((standard-set (remq 'table-cell org-element-all-objects)) + (let* ((minimal-set '(bold code entity italic latex-fragment strike-through + subscript superscript underline verbatim)) + (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) @@ -341,23 +342,20 @@ Don't modify it, set `org-element-affiliated-keywords' instead.") (keyword ,@(remq 'footnote-reference standard-set)) ;; Ignore all 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 statistics-cookie strike-through - subscript superscript underline verbatim) + (link export-snippet inline-babel-call inline-src-block macro + statistics-cookie ,@minimal-set) (paragraph ,@standard-set) ;; Remove any variable object from radio target as it would ;; prevent it from being properly recognized. - (radio-target bold code entity italic latex-fragment strike-through - subscript superscript underline superscript) + (radio-target ,@minimal-set) (strike-through ,@standard-set) (subscript ,@standard-set) (superscript ,@standard-set) ;; Ignore inline babel call and inline source block as formulas ;; are possible. Also ignore line breaks and statistics ;; cookies. - (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-cell export-snippet footnote-reference link macro radio-target + target timestamp ,@minimal-set) (table-row table-cell) (underline ,@standard-set) (verse-block ,@standard-set))) @@ -367,10 +365,6 @@ 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 -markup. - This alist also applies to secondary string. For example, an `headline' type element doesn't directly contain objects, but still has an entry since one of its properties (`:title') does.") @@ -1806,13 +1800,10 @@ Return a list whose CAR is `clock' and CDR is a plist containing ;;;; Comment -(defun org-element-comment-parser (limit affiliated) +(defun org-element-comment-parser (limit) "Parse a comment. -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 `comment' and CDR is a plist containing `:begin', `:end', `:value', `:post-blank', @@ -1820,8 +1811,7 @@ containing `:begin', `:end', `:value', `:post-blank', Assume point is at comment beginning." (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) + (let* ((begin (point)) (value (prog2 (looking-at "[ \t]*# ?") (buffer-substring-no-properties (match-end 0) (line-end-position)) @@ -1843,13 +1833,11 @@ Assume point is at comment beginning." (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) (list 'comment - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines com-end end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list :begin begin + :end end + :value value + :post-blank (count-lines com-end end) + :post-affiliated begin))))) (defun org-element-comment-interpreter (comment _) "Interpret COMMENT element as Org syntax. @@ -2186,9 +2174,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `keyword' and CDR is a plist -containing `:key', `:value', `:begin', `:end', `:post-blank' and -`:post-affiliated' keywords." +Return a list whose CAR is a normalized `keyword' (uppercase) and +CDR is a plist containing `:key', `:value', `:begin', `:end', +`:post-blank' and `:post-affiliated' keywords." (save-excursion ;; An orphaned affiliated keyword is considered as a regular ;; keyword. In this case AFFILIATED is nil, so we take care of @@ -3217,10 +3205,11 @@ Assume point is at the beginning of the link." (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))) (setq end (point))) - ;; Special "file" type link processing. Extract opening + ;; 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") + (setq application (match-string 1 type)) + (setq type "file") (when (string-match "::\\(.*\\)\\'" path) (setq search-option (match-string 1 path)) (setq path (replace-match "" nil nil path))) @@ -3823,12 +3812,6 @@ Assume point is at the first equal sign marker." ;; `org-element--current-element' is the core function of this section. ;; It returns the Lisp representation of the element starting at ;; point. -;; -;; `org-element--current-element' makes use of special modes. They -;; 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', `section' and `table-row'. (defun org-element--current-element (limit &optional granularity mode structure) "Parse the element starting at point. @@ -3848,8 +3831,9 @@ nil), secondary values will not be parsed, since they only contain objects. Optional argument MODE, when non-nil, can be either -`first-section', `section', `planning', `item', `node-property' -and `table-row'. +`first-section', `item', `node-property', `planning', +`property-drawer', `section', `table-row', or `top-comment'. + If STRUCTURE isn't provided but MODE is set to `item', it will be computed. @@ -3879,15 +3863,22 @@ element it has to parse." (org-element-section-parser (or (save-excursion (org-with-limited-levels (outline-next-heading))) limit))) + ;; Comments. + ((looking-at "^[ \t]*#\\(?: \\|$\\)") + (org-element-comment-parser 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)))) + ((and (pcase mode + (`planning (eq ?* (char-after (line-beginning-position 0)))) + ((or `property-drawer `top-comment) + (save-excursion + (beginning-of-line 0) + (not (looking-at "[[:blank:]]*$")))) + (_ nil)) (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 @@ -3896,7 +3887,7 @@ element it has to parse." ;; Clock. ((looking-at org-clock-line-re) (org-element-clock-parser limit)) ;; Inlinetask. - ((org-at-heading-p) + ((looking-at "^\\*+ ") (org-element-inlinetask-parser limit raw-secondary-p)) ;; From there, elements can have affiliated keywords. (t (let ((affiliated (org-element--collect-affiliated-keywords @@ -3910,7 +3901,7 @@ element it has to parse." ;; LaTeX Environment. ((looking-at org-element--latex-begin-environment) (org-element-latex-environment-parser limit affiliated)) - ;; Drawer and Property Drawer. + ;; Drawer. ((looking-at org-drawer-regexp) (org-element-drawer-parser limit affiliated)) ;; Fixed Width @@ -3918,13 +3909,10 @@ element it has to parse." (org-element-fixed-width-parser limit affiliated)) ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and ;; Keywords. - ((looking-at "[ \t]*#") + ((looking-at "[ \t]*#\\+") (goto-char (match-end 0)) (cond - ((looking-at "\\(?: \\|$\\)") - (beginning-of-line) - (org-element-comment-parser limit affiliated)) - ((looking-at "\\+BEGIN_\\(\\S-+\\)") + ((looking-at "BEGIN_\\(\\S-+\\)") (beginning-of-line) (funcall (pcase (upcase (match-string 1)) ("CENTER" #'org-element-center-block-parser) @@ -3937,13 +3925,13 @@ element it has to parse." (_ #'org-element-special-block-parser)) limit affiliated)) - ((looking-at "\\+CALL:") + ((looking-at "CALL:") (beginning-of-line) (org-element-babel-call-parser limit affiliated)) - ((looking-at "\\+BEGIN:? ") + ((looking-at "BEGIN:? ") (beginning-of-line) (org-element-dynamic-block-parser limit affiliated)) - ((looking-at "\\+\\S-+:") + ((looking-at "\\S-+:") (beginning-of-line) (org-element-keyword-parser limit affiliated)) (t @@ -4024,7 +4012,8 @@ When PARSE is non-nil, values from keywords belonging to (skip-chars-backward " \t") (point)))) (if parsed? - (org-element--parse-objects beg end nil restrict) + (save-match-data + (org-element--parse-objects beg end nil restrict)) (org-trim (buffer-substring-no-properties beg end))))) ;; If KWD is a dual keyword, find its secondary value. ;; Maybe parse it. @@ -4144,7 +4133,9 @@ If STRING is the empty string or nil, return nil." (dolist (v local-variables) (ignore-errors (if (symbolp v) (makunbound v) - (set (make-local-variable (car v)) (cdr v))))) + ;; Don't set file name to avoid mishandling hooks (bug#44524) + (unless (memq (car v) '(buffer-file-name buffer-file-truename)) + (set (make-local-variable (car v)) (cdr v)))))) ;; Transferring local variables may put the temporary buffer ;; into a read-only state. Make sure we can insert STRING. (let ((inhibit-read-only t)) (insert string)) @@ -4320,34 +4311,41 @@ looking into captions: ;; `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 +(defsubst org-element--next-mode (mode type parent?) + "Return next mode according to current one. + +MODE is a symbol representing the expectation about the next +element or object. Meaningful values are `first-section', +`item', `node-property', `planning', `property-drawer', +`section', `table-row', `top-comment', and nil. + +TYPE is the type of the current element or object. + +If PARENT? is non-nil, assume the next element or object will be +located inside the current one. " + (if parent? (pcase type (`headline 'section) + ((and (guard (eq mode 'first-section)) `section) 'top-comment) (`inlinetask 'planning) (`plain-list 'item) (`property-drawer 'node-property) (`section 'planning) (`table 'table-row)) - (pcase type + (pcase mode (`item 'item) (`node-property 'node-property) - (`planning 'property-drawer) - (`table-row 'table-row)))) + ((and `planning (guard (eq type 'planning))) 'property-drawer) + (`table-row 'table-row) + ((and `top-comment (guard (eq type 'comment))) 'property-drawer)))) (defun org-element--parse-elements (beg end mode structure granularity visible-only acc) "Parse elements between BEG and END positions. MODE prioritizes some elements over the others. It can be set to -`first-section', `section', `planning', `item', `node-property' -or `table-row'. +`first-section', `item', `node-property', `planning', +`property-drawer', `section', `table-row', `top-comment', or nil. When value is `item', STRUCTURE will be used as the current list structure. @@ -4361,54 +4359,52 @@ elements. Elements are accumulated into ACC." (save-excursion (goto-char beg) - ;; Visible only: skip invisible parts at the beginning of the - ;; element. - (when (and visible-only (org-invisible-p2)) - (goto-char (min (1+ (org-find-visible)) end))) ;; 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))) (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)))) + ;; Visible only: skip invisible parts due to folding. + (if (and visible-only (org-invisible-p nil t)) + (progn + (goto-char (org-find-visible)) + (when (and (eolp) (not (eobp))) (forward-char))) + ;; 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)) + ;; 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'. Ensure GRANULARITY allows 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 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 mode type nil))))) ;; Return result. (apply #'org-element-set-contents acc (nreverse elements))))) @@ -4498,15 +4494,21 @@ to an appropriate container (e.g., a paragraph)." (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))))) + (pcase (aref result 1) + ((and ?\[ + (guard (memq 'link restriction))) + (org-element-link-parser)) + ((and ?f + (guard (memq 'footnote-reference restriction))) + (org-element-footnote-reference-parser)) + ((and (or ?% ?/) + (guard (memq 'statistics-cookie restriction))) + (org-element-statistics-cookie-parser)) + (_ + (or (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 (memq 'link restriction) (org-element-link-parser))))))) @@ -4821,10 +4823,12 @@ indentation removed from its contents." ;; ;; A single public function is provided: `org-element-cache-reset'. ;; -;; Cache is enabled by default, but can be disabled globally with +;; Cache is disabled by default for now because it sometimes triggers +;; freezes, but it can be enabled 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 behavior. +;; `org-element-cache-sync-duration' and +;; `org-element-cache-sync-break' can be tweaked to control caching +;; behavior. ;; ;; Internally, parsed elements are stored in an AVL tree, ;; `org-element--cache'. This tree is updated lazily: whenever @@ -4892,7 +4896,7 @@ with `org-element--cache-compare'. This cache is used in A request is a vector with the following pattern: - \[NEXT BEG END OFFSET PARENT PHASE] + [NEXT BEG END OFFSET PARENT PHASE] Processing a synchronization request consists of three phases: @@ -5450,9 +5454,11 @@ the process stopped before finding the expected result." ;; element following headline above, or first element in ;; buffer. ((not cached) - (when (org-with-limited-levels (outline-previous-heading)) - (setq mode 'planning) - (forward-line)) + (if (org-with-limited-levels (outline-previous-heading)) + (progn + (setq mode 'planning) + (forward-line)) + (setq mode 'top-comment)) (skip-chars-forward " \r\t\n") (beginning-of-line)) ;; Cache returned exact match: return it. @@ -5521,7 +5527,7 @@ the process stopped before finding the expected result." ;; after it. ((and (<= elem-end pos) (/= (point-max) elem-end)) (goto-char elem-end) - (setq mode (org-element--next-mode type nil))) + (setq mode (org-element--next-mode mode type nil))) ;; A non-greater element contains point: return it. ((not (memq type org-element-greater-elements)) (throw 'exit element)) @@ -5549,7 +5555,7 @@ the process stopped before finding the expected result." (and (= cend pos) (= (point-max) pos))))) (goto-char (or next cbeg)) (setq next nil - mode (org-element--next-mode type t) + mode (org-element--next-mode mode type t) parent element end cend)))) ;; Otherwise, return ELEMENT as it is the smallest @@ -5813,7 +5819,7 @@ element. 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. +`:begin', `:end', and `:post-blank' properties. 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 diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index e32ce269b4a..bca0c4338a3 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -226,7 +226,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") - "** Dead languages" + "** Icelandic" ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") @@ -386,7 +386,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("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]" "∅") + ("empty" "\\emptyset" 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]" "∈") diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 30eab9bc6b7..c0556b8bbcd 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -243,6 +243,15 @@ is of course immediately visible, but for example a passed deadline is of the frame, for example." :group 'org-faces) +(defface org-headline-todo ;Copied from `font-lock-string-face' + '((((class color) (min-colors 16) (background light)) (:foreground "Red4")) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink2")) + (((class color) (min-colors 8) (background light)) (:bold t))) + "Face used to indicate that a headline is marked as TODO. +This face is only used if `org-fontify-todo-headline' is set. If applies +to the part of the headline after the TODO keyword." + :group 'org-faces) + (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")) @@ -355,6 +364,12 @@ changes." "Face used for tables." :group 'org-faces) +(defface org-table-header '((t :inherit org-table + :background "LightGray" + :foreground "Black")) + "Face for table header." + :group 'org-faces) + (defface org-formula '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) @@ -393,9 +408,17 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." "Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." :group 'org-faces) -(defface org-block '((t :inherit shadow)) - "Face text in #+begin ... #+end blocks. -For source-blocks `org-src-block-faces' takes precedence." +(defface org-block `((t :inherit shadow + ,@(and (>= emacs-major-version 27) '(:extend t)))) + "Face used for text inside various blocks. + +It is always used for source blocks. You can refine what face +should be used depending on the source block language by setting, +`org-src-block-faces', which takes precedence. + +When `org-fontify-quote-and-verse-blocks' is not nil, text inside +verse and quote blocks are fontified using the `org-verse' and +`org-quote' faces, which inherit from `org-block'." :group 'org-faces :version "26.1") diff --git a/lisp/org/org-goto.el b/lisp/org/org-goto.el index dd9c0fad577..93e6f940c75 100644 --- a/lisp/org/org-goto.el +++ b/lisp/org/org-goto.el @@ -22,27 +22,8 @@ ;;; Code: -(require 'org-macs) -(require 'org-compat) - -(declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-beginning-of-line "org" (&optional n)) -(declare-function org-defkey "org" (keymap key def)) -(declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function org-overview "org" ()) -(declare-function org-refile-check-position "org" (refile-pointer)) -(declare-function org-refile-get-location "org" (&optional prompt default-buffer new-nodes)) -(declare-function org-show-context "org" (&optional key)) -(declare-function org-show-set-visibility "org" (detail)) - -(defvar org-complex-heading-regexp) -(defvar org-startup-align-all-tables) -(defvar org-startup-folded) -(defvar org-startup-truncated) -(defvar org-special-ctrl-a/e) -(defvar org-refile-target-verify-function) -(defvar org-refile-use-outline-path) -(defvar org-refile-targets) +(require 'org) +(require 'org-refile) (defvar org-goto-exit-command nil) (defvar org-goto-map nil) @@ -234,20 +215,15 @@ position or nil." (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) (pop-to-buffer-same-window (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) + (make-indirect-buffer (current-buffer) "*org-goto*" t) + (error (make-indirect-buffer (current-buffer) "*org-goto*" t)))) (let (temp-buffer-show-function temp-buffer-show-hook) (with-output-to-temp-buffer "*Org Help*" (princ (format help (if org-goto-auto-isearch " Just type for auto-isearch." " n/p/f/b/u to navigate, q to quit."))))) (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) - (setq buffer-read-only nil) - (let ((org-startup-truncated t) - (org-startup-folded nil) - (org-startup-align-all-tables nil)) - (org-mode) - (org-overview)) + (org-overview) (setq buffer-read-only t) (if (and (boundp 'org-goto-start-pos) (integer-or-marker-p org-goto-start-pos)) @@ -309,4 +285,8 @@ With a prefix argument, use the alternative interface: e.g., if (provide 'org-goto) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-goto.el ends here diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index e1d13b8325c..f76f0f2131a 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -90,7 +90,7 @@ It will be green even if it was done after the deadline." :type 'boolean) (defcustom org-habit-scheduled-past-days nil - "Value to use instead of `org-scheduled-past-days', for habits only. +"Value to use instead of `org-scheduled-past-days', for habits only. If nil, `org-scheduled-past-days' is used. @@ -343,7 +343,10 @@ current time." (if (and in-the-past-p (not last-done-date) (not (< scheduled now))) - '(org-habit-clear-face . org-habit-clear-future-face) + (if (and all-done-dates (= (car all-done-dates) start)) + ;; This is the very first done of this habit. + '(org-habit-ready-face . org-habit-ready-future-face) + '(org-habit-clear-face . org-habit-clear-future-face)) (org-habit-get-faces habit start (and in-the-past-p @@ -409,7 +412,7 @@ current time." 'help-echo (concat (format-time-string (org-time-stamp-format) - (time-add starting (days-to-time (- start (time-to-days starting))))) + (time-add starting (days-to-time (- start (time-to-days starting))))) (if donep " DONE" "")) graph)) (setq start (1+ start) @@ -436,7 +439,7 @@ current time." habit (time-subtract moment (days-to-time org-habit-preceding-days)) moment - (time-add moment (days-to-time org-habit-following-days)))))) + (time-add moment (days-to-time org-habit-following-days)))))) (forward-line))))) (defun org-habit-toggle-habits () diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 3efbde04d3f..f8af52964e4 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -71,11 +71,11 @@ ;;; Code: (require 'org) +(require 'org-refile) (require 'ol) (declare-function message-make-fqdn "message" ()) (declare-function org-goto-location "org-goto" (&optional _buf help)) -(declare-function org-link-set-parameters "ol" (type &rest rest)) ;;; Customization @@ -259,6 +259,11 @@ Create an ID if necessary." (interactive) (org-kill-new (org-id-get nil 'create))) +(defvar org-id-overriding-file-name nil + "Tell `org-id-get' to use this as the file name when creating an ID. +This is useful when working with contents in a temporary buffer +that will be copied back to the original.") + ;;;###autoload (defun org-id-get (&optional pom create prefix) "Get the ID property of the entry at point-or-marker POM. @@ -275,7 +280,9 @@ In any case, the ID of the entry is returned." (create (setq id (org-id-new prefix)) (org-entry-put pom "ID" id) - (org-id-add-location id (buffer-file-name (buffer-base-buffer))) + (org-id-add-location id + (or org-id-overriding-file-name + (buffer-file-name (buffer-base-buffer)))) id))))) ;;;###autoload @@ -478,55 +485,64 @@ This will scan all agenda files, all associated archives, and all files currently mentioned in `org-id-locations'. When FILES is given, scan also these files." (interactive) - (if (not org-id-track-globally) - (error "Please turn on `org-id-track-globally' if you want to track IDs") - (let* ((files (delete-dups - (mapcar #'file-truename - (append - ;; Agenda files and all associated archives - (org-agenda-files t org-id-search-archives) - ;; Explicit extra files - (unless (symbolp org-id-extra-files) - org-id-extra-files) - ;; All files known to have IDs - org-id-files - ;; function input - files)))) - (nfiles (length files)) - ids seen-ids (ndup 0) (i 0) file-id-alist) - (with-temp-buffer - (delay-mode-hooks - (org-mode) - (dolist (file files) - (unless silent - (setq i (1+ i)) - (message "Finding ID locations (%d/%d files): %s" - i nfiles file)) - (when (file-exists-p file) - (insert-file-contents file nil nil nil 'replace) - (setq ids (org-map-entries - (lambda () - (org-entry-get (point) "ID")) - "ID<>\"\"")) - (dolist (id ids) - (if (member id seen-ids) - (progn - (message "Duplicate ID \"%s\"" id) - (setq ndup (1+ ndup))) - (push id seen-ids))) + (unless org-id-track-globally + (error "Please turn on `org-id-track-globally' if you want to track IDs")) + (setq org-id-locations nil) + (let* ((files + (delete-dups + (mapcar #'file-truename + (cl-remove-if-not + ;; Default `org-id-extra-files' value contains + ;; `agenda-archives' symbol. + #'stringp + (append + ;; Agenda files and all associated archives. + (org-agenda-files t org-id-search-archives) + ;; Explicit extra files. + (if (symbolp org-id-extra-files) + (symbol-value org-id-extra-files) + org-id-extra-files) + ;; All files known to have IDs. + org-id-files + ;; Additional files from function call. + files))))) + (nfiles (length files)) + (id-regexp + (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " "))))) + (seen-ids nil) + (ndup 0) + (i 0)) + (dolist (file files) + (when (file-exists-p file) + (unless silent + (cl-incf i) + (message "Finding ID locations (%d/%d files): %s" i nfiles file)) + (with-current-buffer (find-file-noselect file t) + (let ((ids nil) + (case-fold-search t)) + (org-with-point-at 1 + (while (re-search-forward id-regexp nil t) + (when (org-at-property-p) + (push (org-entry-get (point) "ID") ids))) (when ids - (setq file-id-alist (cons (cons (abbreviate-file-name file) ids) - file-id-alist))))))) - (setq org-id-locations file-id-alist) - (setq org-id-files (mapcar 'car org-id-locations)) - (org-id-locations-save) - ;; now convert to a hash - (setq org-id-locations (org-id-alist-to-hash org-id-locations)) - (when (> ndup 0) - (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) - (message "%d files scanned, %d files contains IDs and in total %d IDs found." - nfiles (length org-id-files) (hash-table-count org-id-locations)) - org-id-locations))) + (push (cons (abbreviate-file-name file) ids) + org-id-locations) + (dolist (id ids) + (cond + ((not (member id seen-ids)) (push id seen-ids)) + (silent nil) + (t + (message "Duplicate ID %S" id) + (cl-incf ndup)))))))))) + (setq org-id-files (mapcar #'car org-id-locations)) + (org-id-locations-save) + ;; Now convert to a hash table. + (setq org-id-locations (org-id-alist-to-hash org-id-locations)) + (when (and (not silent) (> ndup 0)) + (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) + (message "%d files scanned, %d files contains IDs, and %d IDs found." + nfiles (length org-id-files) (hash-table-count org-id-locations)) + org-id-locations)) (defun org-id-locations-save () "Save `org-id-locations' in `org-id-locations-file'." @@ -572,8 +588,10 @@ When FILES is given, scan also these files." (defun org-id-add-location (id file) "Add the ID with location FILE to the database of ID locations." ;; Only if global tracking is on, and when the buffer has a file + (unless file + (error "bug: org-id-get expects a file-visiting buffer")) (let ((afile (abbreviate-file-name file))) - (when (and org-id-track-globally id file) + (when (and org-id-track-globally id) (unless org-id-locations (org-id-locations-load)) (puthash id afile org-id-locations) (unless (member afile org-id-files) @@ -631,7 +649,7 @@ When FILES is given, scan also these files." (or (and org-id-locations (hash-table-p org-id-locations) (gethash id org-id-locations)) - ;; ball back on current buffer + ;; Fall back on current buffer (buffer-file-name (or (buffer-base-buffer (current-buffer)) (current-buffer))))) @@ -665,8 +683,11 @@ optional argument MARKERP, return the position as a new marker." (let* ((link (concat "id:" (org-id-get-create))) (case-fold-search nil) (desc (save-excursion - (org-back-to-heading t) - (or (and (looking-at org-complex-heading-regexp) + (org-back-to-heading-or-point-min t) + (or (and (org-before-first-heading-p) + (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))) + (and (looking-at org-complex-heading-regexp) (if (match-end 4) (match-string 4) (match-string 0))) @@ -674,7 +695,7 @@ optional argument MARKERP, return the position as a new marker." (org-link-store-props :link link :description desc :type "id") link))) -(defun org-id-open (id) +(defun org-id-open (id _) "Go to the entry with id ID." (org-mark-ring-push) (let ((m (org-id-find id 'marker)) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 5171919465b..73b077965c4 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -71,8 +71,6 @@ Delay used when the buffer to initialize isn't current.") (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 - "Used locally.") (defvar org-indent-modified-headline-flag nil "Non-nil means the last deletion operated on a headline. It is modified by `org-indent-notify-modified-headline'.") @@ -178,10 +176,11 @@ during idle time." (setq-local indent-tabs-mode nil) (setq-local org-indent--initial-marker (copy-marker 1)) (when org-indent-mode-turns-off-org-adapt-indentation - (setq-local org-adapt-indentation nil)) + ;; Don't turn off `org-adapt-indentation' when its value is + ;; 'headline-data, just indent headline data specially. + (or (eq org-adapt-indentation 'headline-data) + (setq-local org-adapt-indentation nil))) (when org-indent-mode-turns-on-hiding-stars - (setq-local org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) (setq-local org-hide-leading-stars t)) (org-indent--compute-prefixes) (if (boundp 'filter-buffer-substring-functions) @@ -207,15 +206,14 @@ during idle time." (setq org-indent-agent-timer (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) (t - ;; mode was turned off (or we refused to turn it on) + ;; Mode was turned off (or we refused to turn it on) (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 (boundp 'org-hide-leading-stars-before-indent-mode) - (setq-local org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) + (when (local-variable-p 'org-hide-leading-stars) + (kill-local-variable 'org-hide-leading-stars)) (if (boundp 'filter-buffer-substring-functions) (remove-hook 'filter-buffer-substring-functions (lambda (fun start end delete) @@ -365,7 +363,18 @@ stopped." level (org-list-item-body-column (point)))) ;; Regular line. (t - (org-indent-set-line-properties level (current-indentation)))))))))) + (org-indent-set-line-properties + level + (current-indentation) + ;; When adapt indentation is 'headline-data, use + ;; `org-indent--heading-line-prefixes' for setting + ;; headline data indentation. + (and (eq org-adapt-indentation 'headline-data) + (or (org-at-planning-p) + (org-at-clock-log-p) + (looking-at-p org-property-start-re) + (looking-at-p org-property-end-re) + (looking-at-p org-property-re)))))))))))) (defun org-indent-notify-modified-headline (beg end) "Set `org-indent-modified-headline-flag' depending on context. diff --git a/lisp/org/org-keys.el b/lisp/org/org-keys.el index 4d4e1241c5a..37df2998323 100644 --- a/lisp/org/org-keys.el +++ b/lisp/org/org-keys.el @@ -56,7 +56,7 @@ (declare-function org-clone-subtree-with-time-shift "org" (n &optional shift)) (declare-function org-columns "org" (&optional global columns-fmt-string)) (declare-function org-comment-dwim "org" (arg)) -(declare-function org-copy "org" ()) +(declare-function org-refile-copy "org" ()) (declare-function org-copy-special "org" ()) (declare-function org-copy-visible "org" (beg end)) (declare-function org-ctrl-c-ctrl-c "org" (&optional arg)) @@ -148,7 +148,7 @@ (declare-function org-remove-file "org" (&optional file)) (declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid)) (declare-function org-return "org" (&optional indent)) -(declare-function org-return-indent "org" ()) +(declare-function org-return-and-maybe-indent "org" ()) (declare-function org-reveal "org" (&optional siblings)) (declare-function org-schedule "org" (arg &optional time)) (declare-function org-self-insert-command "org" (N)) @@ -196,6 +196,7 @@ (declare-function org-todo "org" (&optional arg1)) (declare-function org-toggle-archive-tag "org" (&optional find-done)) (declare-function org-toggle-checkbox "org" (&optional toggle-presence)) +(declare-function org-toggle-radio-button "org" (&optional arg)) (declare-function org-toggle-comment "org" ()) (declare-function org-toggle-fixed-width "org" ()) (declare-function org-toggle-inline-images "org" (&optional include-linked)) @@ -218,7 +219,7 @@ ;;; Variables (defvar org-mode-map (make-sparse-keymap) - "Keymap fo Org mode.") + "Keymap for Org mode.") (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) @@ -444,7 +445,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." ;;;; TAB key with modifiers (org-defkey org-mode-map (kbd "C-i") #'org-cycle) (org-defkey org-mode-map (kbd "") #'org-cycle) -(org-defkey org-mode-map (kbd "C-") #'org-force-cycle-archived) +(org-defkey org-mode-map (kbd "C-c C-") #'org-force-cycle-archived) ;; Override text-mode binding to expose `complete-symbol' for ;; pcomplete functionality. (org-defkey org-mode-map (kbd "M-") nil) @@ -580,7 +581,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map (kbd "C-c C-d") #'org-deadline) (org-defkey org-mode-map (kbd "C-c ;") #'org-toggle-comment) (org-defkey org-mode-map (kbd "C-c C-w") #'org-refile) -(org-defkey org-mode-map (kbd "C-c M-w") #'org-copy) +(org-defkey org-mode-map (kbd "C-c M-w") #'org-refile-copy) (org-defkey org-mode-map (kbd "C-c /") #'org-sparse-tree) ;minor-mode reserved (org-defkey org-mode-map (kbd "C-c \\") #'org-match-sparse-tree) ;minor-mode r. (org-defkey org-mode-map (kbd "C-c RET") #'org-ctrl-c-ret) @@ -617,7 +618,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map (kbd "C-c C-k") #'org-kill-note-or-show-branches) (org-defkey org-mode-map (kbd "C-c #") #'org-update-statistics-cookies) (org-defkey org-mode-map (kbd "RET") #'org-return) -(org-defkey org-mode-map (kbd "C-j") #'org-return-indent) +(org-defkey org-mode-map (kbd "C-j") #'org-return-and-maybe-indent) (org-defkey org-mode-map (kbd "C-c ?") #'org-table-field-info) (org-defkey org-mode-map (kbd "C-c SPC") #'org-table-blank-field) (org-defkey org-mode-map (kbd "C-c +") #'org-table-sum) @@ -658,6 +659,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map (kbd "C-c C-x C-M-v") #'org-redisplay-inline-images) (org-defkey org-mode-map (kbd "C-c C-x \\") #'org-toggle-pretty-entities) (org-defkey org-mode-map (kbd "C-c C-x C-b") #'org-toggle-checkbox) +(org-defkey org-mode-map (kbd "C-c C-x C-r") #'org-toggle-radio-button) (org-defkey org-mode-map (kbd "C-c C-x p") #'org-set-property) (org-defkey org-mode-map (kbd "C-c C-x P") #'org-set-property-and-value) (org-defkey org-mode-map (kbd "C-c C-x e") #'org-set-effort) @@ -923,6 +925,10 @@ a-list placed behind the generic `org-babel-key-prefix'.") (interactive) (describe-bindings org-babel-key-prefix)) - (provide 'org-keys) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-keys.el ends here diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 5be1ec72863..e4e0ef75166 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -108,6 +108,7 @@ (require 'cl-lib) (require 'ob) (require 'ol) +(require 'org-attach) (require 'org-macro) (require 'ox) @@ -423,8 +424,10 @@ instead" (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)) + ;; DIR is also used for attachments. + (delete "dir" + (mapcar (lambda (arg) (downcase (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) @@ -541,15 +544,16 @@ Use :header-args: instead" (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")))))))) + (let ((headline? (org-element-lineage d '(headline))) + (before + (mapcar #'org-element-type + (assq d (reverse (org-element-contents + (org-element-property :parent d))))))) + (list (org-element-property :post-affiliated d) + (if (or (and headline? (member before '(nil (planning)))) + (and (null headline?) (member before '(nil (comment))))) + "Incorrect contents for PROPERTIES drawer" + "Incorrect location for PROPERTIES drawer"))))))) (defun org-lint-invalid-effort-property (ast) (org-element-map ast 'node-property @@ -564,16 +568,23 @@ Use :header-args: instead" (defun org-lint-link-to-local-file (ast) (org-element-map ast 'link (lambda (l) - (when (equal "file" (org-element-property :type l)) - (let ((file (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)))))))) + (let ((type (org-element-property :type l))) + (pcase type + ((or "attachment" "file") + (let* ((path (org-element-property :path l)) + (file (if (string= type "file") + path + (org-with-point-at (org-element-property :begin l) + (org-attach-expand path))))) + (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 description" + "Link to non-existent local file %S") + file))))) + (_ nil)))))) (defun org-lint-non-existent-setupfile-parameter (ast) (org-element-map ast 'keyword @@ -793,15 +804,25 @@ Use \"export %s\" instead" (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) + (`drawer + ;; Find drawer opening lines within non-empty drawers. + (let ((end (org-element-property :contents-end element))) + (when end + (while (re-search-forward org-drawer-regexp end t) + (let ((n (org-trim (match-string-no-properties 0)))) + (push (list (line-beginning-position) + (format "Possible misleading drawer entry %S" n)) + reports)))) + (goto-char (org-element-property :end element)))) + (`property-drawer + (goto-char (org-element-property :end element))) ((or `comment-block `example-block `export-block `src-block `verse-block) nil) (_ + ;; Find drawer opening lines outside of any drawer. (push (list (line-beginning-position) - (format "Possible incomplete drawer \"%s\"" name)) + (format "Possible incomplete drawer %S" name)) reports))))) reports)) @@ -1257,6 +1278,10 @@ ARG can also be a list of checker names, as symbols, to run." (org-lint--display-reports (current-buffer) checkers) (message "Org linting process completed")))) - (provide 'org-lint) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-lint.el ends here diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index c79325f1f33..b8383283be8 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -81,12 +81,12 @@ (require 'org-compat) (defvar org-M-RET-may-split-line) +(defvar org-adapt-indentation) (defvar org-auto-align-tags) (defvar org-blank-before-new-entry) (defvar org-clock-string) (defvar org-closed-string) (defvar org-deadline-string) -(defvar org-description-max-indent) (defvar org-done-keywords) (defvar org-drawer-regexp) (defvar org-element-all-objects) @@ -911,13 +911,13 @@ items, as returned by `org-list-prevs-alist'." STRUCT is the list structure." (let* ((item-end (org-list-get-item-end item struct)) (sub-struct (cdr (member (assq item struct) struct))) - subtree) - (catch 'exit - (mapc (lambda (e) - (let ((pos (car e))) - (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) - sub-struct)) - (nreverse subtree))) + items) + (catch :exit + (pcase-dolist (`(,pos . ,_) sub-struct) + (if (< pos item-end) + (push pos items) + (throw :exit nil)))) + (nreverse items))) (defun org-list-get-all-items (item struct prevs) "List all items in the same sub-list as ITEM. @@ -1234,125 +1234,127 @@ after the bullet. Cursor will be after this text once the function ends. This function modifies STRUCT." - (let ((case-fold-search t)) - ;; 1. Get information about list: ITEM containing POS, position of - ;; point with regards to item start (BEFOREP), blank lines - ;; number separating items (BLANK-NB), if we're allowed to - ;; (SPLIT-LINE-P). - (let* ((item (goto-char (catch :exit - (let ((inner-item 0)) - (pcase-dolist (`(,i . ,_) struct) - (cond - ((= i pos) (throw :exit i)) - ((< i pos) (setq inner-item i)) - (t (throw :exit inner-item)))) - inner-item)))) - (item-end (org-list-get-item-end item struct)) - (item-end-no-blank (org-list-get-item-end-before-blank item struct)) - (beforep - (progn - (looking-at org-list-full-item-re) - (<= 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)) - ;; 2. Build the new item to be created. Concatenate same - ;; bullet as item, checkbox, text AFTER-BULLET if - ;; provided, and text cut from point to end of item - ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on - ;; BEFOREP and SPLIT-LINE-P. The difference of size - ;; between what was cut and what was inserted in buffer - ;; is stored in SIZE-OFFSET. - (ind (org-list-get-ind item struct)) - (ind-size (if indent-tabs-mode - (+ (/ ind tab-width) (mod ind tab-width)) - ind)) - (bullet (org-list-bullet-string (org-list-get-bullet item struct))) - (box (when checkbox "[ ]")) - (text-cut - (and (not beforep) split-line-p - (progn - (goto-char pos) - ;; If POS is greater than ITEM-END, then point is - ;; in some white lines after the end of the list. - ;; Those must be removed, or they will be left, - ;; stacking up after the list. - (when (< item-end pos) - (delete-region (1- item-end) (point-at-eol))) - (skip-chars-backward " \r\t\n") - (setq pos (point)) - (delete-and-extract-region pos item-end-no-blank)))) - (body (concat bullet (when box (concat box " ")) after-bullet - (and text-cut - (if (string-match "\\`[ \t]+" text-cut) - (replace-match "" t t text-cut) - text-cut)))) - (item-sep (make-string (1+ blank-nb) ?\n)) - (item-size (+ ind-size (length body) (length item-sep))) - (size-offset (- item-size (length text-cut)))) - ;; 4. Insert effectively item into buffer. - (goto-char item) - (indent-to-column ind) - (insert body item-sep) - ;; 5. Add new item to STRUCT. - (mapc (lambda (e) - (let ((p (car e)) (end (nth 6 e))) - (cond - ;; Before inserted item, positions don't change but - ;; an item ending after insertion has its end shifted - ;; by SIZE-OFFSET. - ((< p item) - (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) - ;; Trivial cases where current item isn't split in - ;; two. Just shift every item after new one by - ;; ITEM-SIZE. - ((or beforep (not split-line-p)) - (setcar e (+ p item-size)) - (setcar (nthcdr 6 e) (+ end item-size))) - ;; Item is split in two: elements before POS are just - ;; shifted by ITEM-SIZE. In the case item would end - ;; after split POS, ending is only shifted by - ;; SIZE-OFFSET. - ((< p pos) - (setcar e (+ p item-size)) - (if (< end pos) - (setcar (nthcdr 6 e) (+ end item-size)) - (setcar (nthcdr 6 e) (+ end size-offset)))) - ;; Elements after POS are moved into new item. - ;; Length of ITEM-SEP has to be removed as ITEM-SEP - ;; doesn't appear in buffer yet. - ((< p item-end) - (setcar e (+ p size-offset (- item pos (length item-sep)))) - (if (= end item-end) - (setcar (nthcdr 6 e) (+ item item-size)) - (setcar (nthcdr 6 e) - (+ end size-offset - (- item pos (length item-sep)))))) - ;; Elements at ITEM-END or after are only shifted by - ;; SIZE-OFFSET. - (t (setcar e (+ p size-offset)) - (setcar (nthcdr 6 e) (+ end size-offset)))))) - struct) - (push (list item ind bullet nil box nil (+ item item-size)) struct) - (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) - ;; 6. If not BEFOREP, new item must appear after ITEM, so - ;; exchange ITEM with the next item in list. Position cursor - ;; after bullet, counter, checkbox, and label. - (if beforep - (goto-char item) - (setq struct (org-list-swap-items item (+ item item-size) struct)) - (goto-char (org-list-get-next-item - item struct (org-list-prevs-alist struct)))) - struct))) + (let* ((case-fold-search t) + ;; Get information about list: ITEM containing POS, position + ;; of point with regards to item start (BEFOREP), blank lines + ;; number separating items (BLANK-NB), if we're allowed to + ;; (SPLIT-LINE-P). + (item + (catch :exit + (let ((i nil)) + (pcase-dolist (`(,start ,_ ,_ ,_ ,_ ,_ ,end) struct) + (cond + ((> start pos) (throw :exit i)) + ((< end pos) nil) ;skip sub-lists before point + (t (setq i start)))) + ;; If no suitable item is found, insert a sibling of the + ;; last item in buffer. + (or i (caar (reverse struct)))))) + (item-end (org-list-get-item-end item struct)) + (item-end-no-blank (org-list-get-item-end-before-blank item struct)) + (beforep + (progn + (goto-char item) + (looking-at org-list-full-item-re) + (<= 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)) + ;; Build the new item to be created. Concatenate same bullet + ;; as item, checkbox, text AFTER-BULLET if provided, and text + ;; cut from point to end of item (TEXT-CUT) to form item's + ;; BODY. TEXT-CUT depends on BEFOREP and SPLIT-LINE-P. The + ;; difference of size between what was cut and what was + ;; inserted in buffer is stored in SIZE-OFFSET. + (ind (org-list-get-ind item struct)) + (ind-size (if indent-tabs-mode + (+ (/ ind tab-width) (mod ind tab-width)) + ind)) + (bullet (org-list-bullet-string (org-list-get-bullet item struct))) + (box (and checkbox "[ ]")) + (text-cut + (and (not beforep) + split-line-p + (progn + (goto-char pos) + ;; If POS is greater than ITEM-END, then point is in + ;; some white lines after the end of the list. Those + ;; must be removed, or they will be left, stacking up + ;; after the list. + (when (< item-end pos) + (delete-region (1- item-end) (point-at-eol))) + (skip-chars-backward " \r\t\n") + ;; Cut position is after any blank on the line. + (save-excursion + (skip-chars-forward " \t") + (setq pos (point))) + (delete-and-extract-region (point) item-end-no-blank)))) + (body + (concat bullet + (and box (concat box " ")) + after-bullet + (and text-cut + (if (string-match "\\`[ \t]+" text-cut) + (replace-match "" t t text-cut) + text-cut)))) + (item-sep (make-string (1+ blank-nb) ?\n)) + (item-size (+ ind-size (length body) (length item-sep))) + (size-offset (- item-size (length text-cut)))) + ;; Insert effectively item into buffer. + (goto-char item) + (indent-to-column ind) + (insert body item-sep) + ;; Add new item to STRUCT. + (dolist (e struct) + (let ((p (car e)) (end (nth 6 e))) + (cond + ;; Before inserted item, positions don't change but an item + ;; ending after insertion has its end shifted by SIZE-OFFSET. + ((< p item) + (when (> end item) + (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Item where insertion happens may be split in two parts. + ;; In this case, move start by ITEM-SIZE and end by + ;; SIZE-OFFSET. + ((and (= p item) (not beforep) split-line-p) + (setcar e (+ p item-size)) + (setcar (nthcdr 6 e) (+ end size-offset))) + ;; Items starting after modified item fall into two + ;; categories. + ;; + ;; If modified item was split, and current sub-item was + ;; located after split point, it was moved to the new item: + ;; the part between body start and split point (POS) was + ;; removed. So we compute the length of that part and shift + ;; item's positions accordingly. + ;; + ;; Otherwise, the item was simply shifted by SIZE-OFFSET. + ((and split-line-p (not beforep) (>= p pos) (<= p item-end-no-blank)) + (let ((offset (- pos item ind (length bullet) (length after-bullet)))) + (setcar e (- p offset)) + (setcar (nthcdr 6 e) (- end offset)))) + (t + (setcar e (+ p size-offset)) + (setcar (nthcdr 6 e) (+ end size-offset)))))) + (push (list item ind bullet nil box nil (+ item item-size)) struct) + (setq struct (sort struct #'car-less-than-car)) + ;; If not BEFOREP, new item must appear after ITEM, so exchange + ;; ITEM with the next item in list. Position cursor after bullet, + ;; counter, checkbox, and label. + (if beforep + (goto-char item) + (setq struct (org-list-swap-items item (+ item item-size) struct)) + (goto-char (org-list-get-next-item + item struct (org-list-prevs-alist struct)))) + struct)) (defun org-list-delete-item (item struct) "Remove ITEM from the list and return the new structure. @@ -1793,10 +1795,9 @@ This function modifies STRUCT." ;; There are boxes checked after an unchecked one: fix that. (when (member "[X]" after-unchecked) (let ((index (- (length struct) (length after-unchecked)))) - (mapc (lambda (e) - (when (org-list-get-checkbox e struct) - (org-list-set-checkbox e struct "[ ]"))) - (nthcdr index all-items)) + (dolist (e (nthcdr index all-items)) + (when (org-list-get-checkbox e struct) + (org-list-set-checkbox e struct "[ ]"))) ;; Verify once again the structure, without ORDERED. (org-list-struct-fix-box struct parents prevs nil) ;; Return blocking item. @@ -1807,24 +1808,22 @@ This function modifies STRUCT." This function modifies STRUCT." (let (end-list acc-end) - (mapc (lambda (e) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (end-pos (org-list-get-item-end pos struct))) - (unless (assq end-pos struct) - ;; To determine real ind of an ending position that is - ;; not at an item, we have to find the item it 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 '>))) - (push (cons - ;; Else part is for the bottom point. - (if item-up (+ (org-list-get-ind item-up struct) 2) 0) - end-pos) - end-list))) - (push (cons ind-pos pos) end-list) - (push (cons end-pos pos) acc-end))) - struct) + (pcase-dolist (`(,pos . ,_) struct) + (let ((ind-pos (org-list-get-ind pos struct)) + (end-pos (org-list-get-item-end pos struct))) + (unless (assq end-pos struct) + ;; To determine real ind of an ending position that is not + ;; at an item, we have to find the item it 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 #'>))) + (push (cons + ;; Else part is for the bottom point. + (if item-up (+ (org-list-get-ind item-up struct) 2) 0) + end-pos) + end-list))) + (push (cons ind-pos pos) end-list) + (push (cons end-pos pos) acc-end))) (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) (org-list-struct-assoc-end struct end-list))) @@ -2021,10 +2020,9 @@ beginning of the item." (item (copy-marker (point-at-bol))) (all (org-list-get-all-items (marker-position item) struct prevs)) (value init-value)) - (mapc (lambda (e) - (goto-char e) - (setq value (apply function value args))) - (nreverse all)) + (dolist (e (nreverse all)) + (goto-char e) + (setq value (apply function value args))) (goto-char item) (move-marker item nil) value)) @@ -2046,9 +2044,8 @@ Possible values are: `folded', `children' or `subtree'. See ;; Then fold every child. (let* ((parents (org-list-parents-alist struct)) (children (org-list-get-children item struct parents))) - (mapc (lambda (e) - (org-list-set-item-visibility e struct 'folded)) - children))) + (dolist (child children) + (org-list-set-item-visibility child struct 'folded)))) ((eq view 'subtree) ;; Show everything (let ((item-end (org-list-get-item-end item struct))) @@ -2303,6 +2300,56 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (org-list-struct-fix-ind struct parents) (org-list-struct-apply-struct struct old-struct))))) +;;;###autoload +(define-minor-mode org-list-checkbox-radio-mode + "When turned on, use list checkboxes as radio buttons." + nil " CheckBoxRadio" nil + (unless (eq major-mode 'org-mode) + (user-error "Cannot turn this mode outside org-mode buffers"))) + +(defun org-toggle-radio-button (&optional arg) + "Toggle off all checkboxes and toggle on the one at point." + (interactive "P") + (if (not (org-at-item-p)) + (user-error "Cannot toggle checkbox outside of a list") + (let* ((cpos (org-in-item-p)) + (struct (org-list-struct)) + (orderedp (org-entry-get nil "ORDERED")) + (parents (org-list-parents-alist struct)) + (old-struct (copy-tree struct)) + (cbox (org-list-get-checkbox cpos struct)) + (prevs (org-list-prevs-alist struct)) + (start (org-list-get-list-begin (point-at-bol) struct prevs)) + (new (unless (and cbox (equal arg '(4)) (equal start cpos)) + "[ ]"))) + (dolist (pos (org-list-get-all-items + start struct (org-list-prevs-alist struct))) + (org-list-set-checkbox pos struct new)) + (when new + (org-list-set-checkbox + cpos struct + (cond ((equal arg '(4)) (unless cbox "[ ]")) + ((equal arg '(16)) (unless cbox "[-]")) + (t (if (equal cbox "[X]") "[ ]" "[X]"))))) + (org-list-struct-fix-box struct parents prevs orderedp) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)))) + +(defun org-at-radio-list-p () + "Is point at a list item with radio buttons?" + (when (org-match-line (org-item-re)) ;short-circuit + (let* ((e (save-excursion (beginning-of-line) (org-element-at-point)))) + ;; Check we're really on a line with a bullet. + (when (memq (org-element-type e) '(item plain-list)) + ;; Look for ATTR_ORG attribute in the current plain list. + (let ((plain-list (org-element-lineage e '(plain-list) t))) + (org-with-point-at (org-element-property :post-affiliated plain-list) + (let ((case-fold-search t) + (regexp "^[ \t]*#\\+attr_org:.* :radio \\(\\S-+\\)") + (begin (org-element-property :begin plain-list))) + (and (re-search-backward regexp begin t) + (not (string-equal "nil" (match-string 1))))))))))) + (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. @@ -2317,92 +2364,94 @@ If point is on a headline, apply this to all checkbox items in the text below the heading, taking as reference the first item in subtree, ignoring planning line and any drawer following it." (interactive "P") - (save-excursion - (let* (singlep - block-item - lim-up - lim-down - (orderedp (org-entry-get nil "ORDERED")) - (_bounds - ;; In a region, start at first item in region. + (if (org-at-radio-list-p) + (org-toggle-radio-button toggle-presence) + (save-excursion + (let* (singlep + block-item + lim-up + lim-down + (orderedp (org-entry-get nil "ORDERED")) + (_bounds + ;; In a region, start at first item in region. + (cond + ((org-region-active-p) + (let ((limit (region-end))) + (goto-char (region-beginning)) + (if (org-list-search-forward (org-item-beginning-re) limit t) + (setq lim-up (point-at-bol)) + (error "No item in region")) + (setq lim-down (copy-marker limit)))) + ((org-at-heading-p) + ;; On a heading, start at first item after drawers and + ;; time-stamps (scheduled, etc.). + (let ((limit (save-excursion (outline-next-heading) (point)))) + (org-end-of-meta-data t) + (if (org-list-search-forward (org-item-beginning-re) limit t) + (setq lim-up (point-at-bol)) + (error "No item in subtree")) + (setq lim-down (copy-marker limit)))) + ;; Just one item: set SINGLEP flag. + ((org-at-item-p) + (setq singlep t) + (setq lim-up (point-at-bol) + lim-down (copy-marker (point-at-eol)))) + (t (error "Not at an item or heading, and no active region")))) + ;; Determine the checkbox going to be applied to all items + ;; within bounds. + (ref-checkbox + (progn + (goto-char lim-up) + (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) + (cond + ((equal toggle-presence '(16)) "[-]") + ((equal toggle-presence '(4)) + (unless cbox "[ ]")) + ((equal "[X]" cbox) "[ ]") + (t "[X]")))))) + ;; When an item is found within bounds, grab the full list at + ;; point structure, then: (1) set check-box of all its items + ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the + ;; whole list, (3) move point after the list. + (goto-char lim-up) + (while (and (< (point) lim-down) + (org-list-search-forward (org-item-beginning-re) + lim-down 'move)) + (let* ((struct (org-list-struct)) + (struct-copy (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (bottom (copy-marker (org-list-get-bottom-point struct))) + (items-to-toggle (cl-remove-if + (lambda (e) (or (< e lim-up) (> e lim-down))) + (mapcar #'car struct)))) + (dolist (e items-to-toggle) + (org-list-set-checkbox + e struct + ;; If there is no box at item, leave as-is unless + ;; function was called with C-u prefix. + (let ((cur-box (org-list-get-checkbox e struct))) + (if (or cur-box (equal toggle-presence '(4))) + ref-checkbox + cur-box)))) + (setq block-item (org-list-struct-fix-box + struct parents prevs orderedp)) + ;; Report some problems due to ORDERED status of subtree. + ;; If only one box was being checked, throw an error, else, + ;; only signal problems. (cond - ((org-region-active-p) - (let ((limit (region-end))) - (goto-char (region-beginning)) - (if (org-list-search-forward (org-item-beginning-re) limit t) - (setq lim-up (point-at-bol)) - (error "No item in region")) - (setq lim-down (copy-marker limit)))) - ((org-at-heading-p) - ;; On a heading, start at first item after drawers and - ;; time-stamps (scheduled, etc.). - (let ((limit (save-excursion (outline-next-heading) (point)))) - (org-end-of-meta-data t) - (if (org-list-search-forward (org-item-beginning-re) limit t) - (setq lim-up (point-at-bol)) - (error "No item in subtree")) - (setq lim-down (copy-marker limit)))) - ;; Just one item: set SINGLEP flag. - ((org-at-item-p) - (setq singlep t) - (setq lim-up (point-at-bol) - lim-down (copy-marker (point-at-eol)))) - (t (error "Not at an item or heading, and no active region")))) - ;; Determine the checkbox going to be applied to all items - ;; within bounds. - (ref-checkbox - (progn - (goto-char lim-up) - (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) - (cond - ((equal toggle-presence '(16)) "[-]") - ((equal toggle-presence '(4)) - (unless cbox "[ ]")) - ((equal "[X]" cbox) "[ ]") - (t "[X]")))))) - ;; When an item is found within bounds, grab the full list at - ;; point structure, then: (1) set check-box of all its items - ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the - ;; whole list, (3) move point after the list. - (goto-char lim-up) - (while (and (< (point) lim-down) - (org-list-search-forward (org-item-beginning-re) - lim-down 'move)) - (let* ((struct (org-list-struct)) - (struct-copy (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - (bottom (copy-marker (org-list-get-bottom-point struct))) - (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 - e struct - ;; If there is no box at item, leave as-is - ;; unless function was called with C-u prefix. - (let ((cur-box (org-list-get-checkbox e struct))) - (if (or cur-box (equal toggle-presence '(4))) - ref-checkbox - cur-box)))) - items-to-toggle) - (setq block-item (org-list-struct-fix-box - struct parents prevs orderedp)) - ;; Report some problems due to ORDERED status of subtree. - ;; If only one box was being checked, throw an error, else, - ;; only signal problems. - (cond - ((and singlep block-item (> lim-up block-item)) - (error - "Checkbox blocked because of unchecked box at line %d" - (org-current-line block-item))) - (block-item - (message - "Checkboxes were removed due to unchecked box at line %d" - (org-current-line block-item)))) - (goto-char bottom) - (move-marker bottom nil) - (org-list-struct-apply-struct struct struct-copy))) - (move-marker lim-down nil))) + ((and singlep block-item (> lim-up block-item)) + (error + "Checkbox blocked because of unchecked box at line %d" + (org-current-line block-item))) + (block-item + (message + "Checkboxes were removed due to unchecked box at line %d" + (org-current-line block-item)))) + (goto-char bottom) + (move-marker bottom nil) + (org-list-struct-apply-struct struct struct-copy))) + (move-marker lim-down nil)))) (org-update-checkbox-count-maybe)) (defun org-reset-checkbox-state-subtree () @@ -2632,10 +2681,9 @@ Return t if successful." (org-list-bullet-string "-"))) ;; Shift every item by OFFSET and fix bullets. Then ;; apply changes to buffer. - (mapc (lambda (e) - (let ((ind (org-list-get-ind (car e) struct))) - (org-list-set-ind (car e) struct (+ ind offset)))) - struct) + (pcase-dolist (`(,pos . ,_) struct) + (let ((ind (org-list-get-ind pos struct))) + (org-list-set-ind pos struct (+ ind offset)))) (org-list-struct-fix-bul struct prevs) (org-list-struct-apply-struct struct old-struct)))) ;; Forbidden move: @@ -2733,51 +2781,83 @@ If a region is active, all items inside will be moved." (t (error "Not at an item"))))) (defvar org-tab-ind-state) -(defvar org-adapt-indentation) (defun org-cycle-item-indentation () "Cycle levels of indentation of an empty item. + The first run indents the item, if applicable. Subsequent runs outdent it at meaningful levels in the list. When done, item is put back at its original position with its original bullet. Return t at each successful move." (when (org-at-item-p) - (let* ((org-adapt-indentation nil) - (struct (org-list-struct)) - (ind (org-list-get-ind (point-at-bol) struct)) - (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol))))) + (let* ((struct (org-list-struct)) + (item (line-beginning-position)) + (ind (org-list-get-ind item struct))) ;; Accept empty items or if cycle has already started. (when (or (eq last-command 'org-cycle-item-indentation) - (and (save-excursion - (beginning-of-line) - (looking-at org-list-full-item-re)) - (>= (match-end 0) (save-excursion - (goto-char (org-list-get-item-end - (point-at-bol) struct)) - (skip-chars-backward " \r\t\n") - (point))))) + (and (org-match-line org-list-full-item-re) + (>= (match-end 0) + (save-excursion + (goto-char (org-list-get-item-end item struct)) + (skip-chars-backward " \t\n") + (point))))) (setq this-command 'org-cycle-item-indentation) - ;; When in the middle of the cycle, try to outdent first. If - ;; it fails, and point is still at initial position, indent. - ;; Else, re-create it at its original position. - (if (eq last-command 'org-cycle-item-indentation) + (let ((prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct))) + (if (eq last-command 'org-cycle-item-indentation) + ;; When in the middle of the cycle, try to outdent. If + ;; it fails, move point back to its initial position and + ;; reset cycle. + (pcase-let ((`(,old-ind . ,old-bul) org-tab-ind-state) + (allow-outdent + (lambda (struct prevs parents) + ;; Non-nil if current item can be + ;; outdented. + (and (not (org-list-get-next-item item nil prevs)) + (not (org-list-has-child-p item struct)) + (org-list-get-parent item struct parents))))) + (cond + ((and (> ind old-ind) + (org-list-get-prev-item item nil prevs)) + (org-list-indent-item-generic 1 t struct)) + ((and (< ind old-ind) + (funcall allow-outdent struct prevs parents)) + (org-list-indent-item-generic -1 t struct)) + (t + (delete-region (line-beginning-position) (line-end-position)) + (indent-to-column old-ind) + (insert old-bul " ") + (let* ((struct (org-list-struct)) + (parents (org-list-parents-alist struct))) + (if (and (> ind old-ind) + ;; We were previously indenting item. It + ;; is no longer possible. Try to outdent + ;; from initial position. + (funcall allow-outdent + struct + (org-list-prevs-alist struct) + parents)) + (org-list-indent-item-generic -1 t struct) + (org-list-write-struct struct parents) + ;; Start cycle over. + (setq this-command 'identity) + t))))) + ;; If a cycle is starting, remember initial indentation + ;; and bullet, then try to indent. If it fails, try to + ;; outdent. + (setq org-tab-ind-state + (cons ind (org-trim (org-current-line-string)))) (cond - ((ignore-errors (org-list-indent-item-generic -1 t struct))) - ((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)) - (indent-to-column (car org-tab-ind-state)) - (insert (cdr org-tab-ind-state) " ") - ;; Break cycle - (setq this-command 'identity))) - ;; If a cycle is starting, remember indentation and bullet, - ;; then try to indent. If it fails, try to outdent. - (setq org-tab-ind-state (cons ind bullet)) - (cond - ((ignore-errors (org-list-indent-item-generic 1 t struct))) - ((ignore-errors (org-list-indent-item-generic -1 t struct))) - (t (user-error "Cannot move item")))) - t)))) + ((org-list-get-prev-item item nil prevs) + (org-list-indent-item-generic 1 t struct)) + ((and (not (org-list-get-next-item item nil prevs)) + (org-list-get-parent item struct parents)) + (org-list-indent-item-generic -1 t struct)) + (t + ;; This command failed. So will the following one. + ;; There's no point in starting the cycle. + (setq this-command 'identity) + (user-error "Cannot move item"))))))))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func interactive?) @@ -2794,8 +2874,8 @@ if the current locale allows for it. 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 ?f ?F ?x ?X). Here is the -detailed meaning of each character: +be a character, among ?n ?N ?a ?A ?t ?T ?f ?F ?x or ?X. Here is +the detailed meaning of each character: n Numerically, by converting the beginning of the item to a number. a Alphabetically. Only the first line of item is checked. @@ -2958,7 +3038,7 @@ With a prefix argument ARG, change the region in a single item." (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)) + (setq beg (point-at-bol) end (copy-marker (point-at-eol)))) ;; Depending on the starting line, choose an action on the text ;; between BEG and END. @@ -3501,4 +3581,8 @@ overruling parameters for `org-list-to-generic'." (provide 'org-list) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-list.el ends here diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index a1b987a8e26..5ddfae4e1f6 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -50,6 +50,7 @@ (require 'org-macs) (require 'org-compat) +(declare-function org-collect-keywords "org" (keywords &optional unique directory)) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-copy "org-element" (datum)) @@ -88,49 +89,24 @@ directly, use instead: VALUE is the template of the macro. The new value override the previous one, unless VALUE is nil. TEMPLATES is the list of templates. Return the updated list." - (when value - (let ((old-definition (assoc name templates))) - (if old-definition - (setcdr old-definition value) - (push (cons name value) templates)))) + (let ((old-definition (assoc name templates))) + (cond ((and value old-definition) (setcdr old-definition value)) + (old-definition) + (t (push (cons name (or value "")) templates)))) templates) -(defun org-macro--collect-macros (&optional files templates) +(defun org-macro--collect-macros () "Collect macro definitions in current buffer and setup files. -Return an alist containing all macro templates found. - -FILES is a list of setup files names read so far, used to avoid -circular dependencies. TEMPLATES is the alist collected so far. -The two arguments are used in recursive calls." - (let ((case-fold-search t)) - (org-with-point-at 1 - (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 "MACRO" (org-element-property :key element)) - ;; Install macro in TEMPLATES. - (when (string-match "^\\(\\S-+\\)[ \t]*" val) - (let ((name (match-string 1 val)) - (value (substring val (match-end 0)))) - (setq templates - (org-macro--set-template name value templates)))) - ;; Enter setup file. - (let* ((uri (org-strip-quotes 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 - (unless uri-is-url - (setq default-directory (file-name-directory uri))) - (org-mode) - (insert (org-file-contents uri 'noerror)) - (setq templates - (org-macro--collect-macros - (cons uri files) templates))))))))))) +Return an alist containing all macro templates found." + (let ((templates nil)) + (pcase (org-collect-keywords '("MACRO")) + (`(("MACRO" . ,values)) + (dolist (value values) + (when (string-match "^\\(\\S-+\\)[ \t]*" value) + (let ((name (match-string 1 value)) + (definition (substring value (match-end 0)))) + (setq templates + (org-macro--set-template name definition templates))))))) (let ((macros `(("author" . ,(org-macro--find-keyword-value "AUTHOR")) ("email" . ,(org-macro--find-keyword-value "EMAIL")) ("title" . ,(org-macro--find-keyword-value "TITLE" t)) @@ -417,6 +393,6 @@ Any other non-empty string resets the counter to 1." (t 1)) org-macro--counter-table))) - (provide 'org-macro) + ;;; org-macro.el ends here diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 2a7ab66a339..f25efe07f33 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -34,6 +34,7 @@ (require 'cl-lib) (require 'format-spec) +(declare-function org-show-context "org" (&optional key)) (declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) (defvar org-ts-regexp0) @@ -122,7 +123,7 @@ means that the buffer should stay alive during the operation, because otherwise all these markers will point to nowhere." (declare (debug (form body)) (indent 1)) (org-with-gensyms (data invisible-types markers?) - `(let* ((,invisible-types '(org-hide-block org-hide-drawer outline)) + `(let* ((,invisible-types '(org-hide-block outline)) (,markers? ,use-markers) (,data (mapcar (lambda (o) @@ -416,6 +417,7 @@ is selected, only the bare key is returned." (let ((inhibit-quit t) (buffer (org-switch-to-buffer-other-window "*Org Select*")) (prompt (or prompt "Select: ")) + case-fold-search current) (unwind-protect (catch 'exit @@ -644,6 +646,25 @@ The number of levels is controlled by `org-inlinetask-min-level'." limit-level))) (format "\\*\\{1,%d\\} " nstars))))) +(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'." + (and (not (bobp)) + (save-excursion + (beginning-of-line n) + (looking-at-p "[ \t]*$")))) + +(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)) + +(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)) + ;;; Motion @@ -695,7 +716,9 @@ SPEC is the invisibility spec, as a symbol." (let ((o (make-overlay from to nil 'front-advance))) (overlay-put o 'evaporate t) (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'delete-overlay)))) + (overlay-put o + 'isearch-open-invisible + (lambda (&rest _) (org-show-context 'isearch)))))) @@ -920,7 +943,8 @@ if necessary." (if (<= (length s) maxlength) s (let* ((n (max (- maxlength 4) 1)) - (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)"))) + (re (concat "\\`\\(.\\{1," (number-to-string n) + "\\}[^ ]\\)\\([ ]\\|\\'\\)"))) (if (string-match re s) (concat (match-string 1 s) "...") (concat (substring s 0 (max (- maxlength 3) 0)) "..."))))) @@ -1065,10 +1089,16 @@ the value in cdr." (get-text-property (or (next-single-property-change 0 prop s) 0) prop s))) -(defun org-invisible-p (&optional pos) +(defun org-invisible-p (&optional pos folding-only) "Non-nil if the character after POS is invisible. -If POS is nil, use `point' instead." - (get-char-property (or pos (point)) 'invisible)) +If POS is nil, use `point' instead. When optional argument +FOLDING-ONLY is non-nil, only consider invisible parts due to +folding of a headline, a block or a drawer, i.e., not because of +fontification." + (let ((value (get-char-property (or pos (point)) 'invisible))) + (cond ((not value) nil) + (folding-only (memq value '(org-hide-block outline))) + (t value)))) (defun org-truely-invisible-p () "Check if point is at a character currently not visible. @@ -1086,6 +1116,18 @@ move it back by one char before doing this check." (backward-char 1)) (org-invisible-p))) +(defun org-find-visible () + "Return closest visible buffer position, or `point-max'" + (if (org-invisible-p) + (next-single-char-property-change (point) 'invisible) + (point))) + +(defun org-find-invisible () + "Return closest invisible buffer position, or `point-max'" + (if (org-invisible-p) + (point) + (next-single-char-property-change (point) 'invisible))) + ;;; Time @@ -1182,8 +1224,41 @@ Return 0. if S is not recognized as a valid value." ((string-match org-ts-regexp0 s) (org-2ft s)) (t 0.))))) - +(defun org-scroll (key &optional additional-keys) + "Receive KEY and scroll the current window accordingly. +When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the +allowed keys for scrolling, as expected in the export dispatch +window." + (let ((scrlup (if additional-keys '(?\s 22) 22)) + (scrldn (if additional-keys `(?\d 134217846) 134217846))) + (eval + `(cl-case ,key + ;; C-n + (14 (if (not (pos-visible-in-window-p (point-max))) + (ignore-errors (scroll-up 1)) + (message "End of buffer") + (sit-for 1))) + ;; C-p + (16 (if (not (pos-visible-in-window-p (point-min))) + (ignore-errors (scroll-down 1)) + (message "Beginning of buffer") + (sit-for 1))) + ;; SPC or + (,scrlup + (if (not (pos-visible-in-window-p (point-max))) + (scroll-up nil) + (message "End of buffer") + (sit-for 1))) + ;; DEL + (,scrldn (if (not (pos-visible-in-window-p (point-min))) + (scroll-down nil) + (message "Beginning of buffer") + (sit-for 1))))))) (provide 'org-macs) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-macs.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 8749e496c25..6df567d6377 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -258,6 +258,17 @@ the old and new values for the entry.") (defvar org-mobile-files-alist nil) (defvar org-mobile-checksum-files nil) +;; Add org mobile commands to the main org menu +(easy-menu-add-item + org-org-menu + nil + '("MobileOrg" + ["Push Files and Views" org-mobile-push t] + ["Get Captured and Flagged" org-mobile-pull t] + ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] + "--" + ["Setup" (customize-group 'org-mobile) t])) + (defun org-mobile-prepare-file-lists () (setq org-mobile-files-alist (org-mobile-files-alist)) (setq org-mobile-checksum-files nil)) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 02798874d24..d8877630241 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -386,7 +386,7 @@ DEFAULT is returned if no priority is given in the headline." (save-excursion (if (org-mouse-re-search-line org-mouse-priority-regexp) (match-string 1) - (when default (char-to-string org-default-priority))))) + (when default (char-to-string org-priority-default))))) (defun org-mouse-delete-timestamp () "Deletes the current timestamp as well as the preceding keyword. @@ -407,7 +407,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (> (match-end 0) point)))))) (defun org-mouse-priority-list () - (cl-loop for priority from ?A to org-lowest-priority + (cl-loop for priority from ?A to org-priority-lowest collect (char-to-string priority))) (defun org-mouse-todo-menu (state) @@ -495,7 +495,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ["Check Deadlines" (if (functionp 'org-check-deadlines-and-todos) (org-check-deadlines-and-todos org-deadline-warning-days) - (org-check-deadlines org-deadline-warning-days)) t] + (org-check-deadlines org-deadline-warning-days)) + t] ["Check TODOs" org-show-todo-tree t] ("Check Tags" ,@(org-mouse-keyword-menu @@ -741,7 +742,8 @@ This means, between the beginning of line and the point." (?$ "($) Formula Parameters") (?# "(#) Recalculation: Auto") (?* "(*) Recalculation: Manual") - (?' "(') Recalculation: None"))) t)))) + (?' "(') Recalculation: None"))) + t)))) ((assq :table contextlist) (popup-menu '(nil diff --git a/lisp/org/org-num.el b/lisp/org/org-num.el index 5b8e1dbb6d1..167db18ed2d 100644 --- a/lisp/org/org-num.el +++ b/lisp/org/org-num.el @@ -254,6 +254,7 @@ otherwise." org-footnote-section (equal title org-footnote-section)) (and org-num-skip-commented + title (let ((case-fold-search nil)) (string-match org-num--comment-re title)) t) @@ -466,6 +467,10 @@ NUMBERING is a list of numbers." (remove-hook 'after-change-functions #'org-num--verify t) (remove-hook 'change-major-mode-hook #'org-num--clear t)))) - (provide 'org-num) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org-num.el ends here diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index b0ebbc4c241..4b2da9d6948 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -32,6 +32,8 @@ (require 'pcomplete) (declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function org-babel-combine-header-arg-lists "ob-core" (original &rest others)) +(declare-function org-babel-get-src-block-info "ob-core" (&optional light datum)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-buffer-property-keys "org" (&optional specials defaults columns)) (declare-function org-element-at-point "org-element" ()) @@ -47,8 +49,9 @@ (declare-function org-link-heading-search-string "ol" (&optional string)) (declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) +(defvar org-babel-common-header-args-w-values) (defvar org-current-tag-alist) -(defvar org-default-priority) +(defvar org-priority-default) (defvar org-drawer-regexp) (defvar org-element-affiliated-keywords) (defvar org-entities) @@ -56,10 +59,10 @@ (defvar org-export-exclude-tags) (defvar org-export-select-tags) (defvar org-file-tags) -(defvar org-highest-priority) +(defvar org-priority-highest) (defvar org-link-abbrev-alist) (defvar org-link-abbrev-alist-local) -(defvar org-lowest-priority) +(defvar org-priority-lowest) (defvar org-options-keywords) (defvar org-outline-regexp) (defvar org-property-re) @@ -252,9 +255,9 @@ When completing for #+STARTUP, for example, this function returns (defun pcomplete/org-mode/file-option/priorities () "Complete arguments for the #+PRIORITIES file option." (pcomplete-here (list (format "%c %c %c" - org-highest-priority - org-lowest-priority - org-default-priority)))) + org-priority-highest + org-priority-lowest + org-priority-default)))) (defun pcomplete/org-mode/file-option/select_tags () "Complete arguments for the #+SELECT_TAGS file option." @@ -352,8 +355,9 @@ This needs more work, to handle headings with lots of spaces in them." (goto-char (point-min)) (let (tbl) (while (re-search-forward org-outline-regexp nil t) - (push (org-link-heading-search-string (org-get-heading t t t t)) - tbl)) + ;; Remove the leading asterisk from + ;; `org-link-heading-search-string' result. + (push (substring (org-link-heading-search-string) 1) tbl)) (pcomplete-uniquify-list tbl))) ;; When completing a bracketed link, i.e., "[[*", argument ;; starts at the star, so remove this character. @@ -417,11 +421,17 @@ switches." (symbol-plist 'org-babel-load-languages) 'custom-type))))))) - (while (pcomplete-here - '("-n" "-r" "-l" - ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" - ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" - ":session" ":shebang" ":tangle" ":tangle-mode" ":var")))) + (let* ((info (org-babel-get-src-block-info 'light)) + (lang (car info)) + (lang-headers (intern (concat "org-babel-header-args:" lang))) + (headers (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (and (boundp lang-headers) (eval lang-headers t))))) + (while (pcomplete-here + (append (mapcar + (lambda (arg) (format ":%s" (symbol-name (car arg)))) + headers) + '("-n" "-r" "-l")))))) (defun pcomplete/org-mode/block-option/clocktable () "Complete keywords in a clocktable line." diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 8bf883921c9..57b280fe383 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2008-2020 Free Software Foundation, Inc. ;; ;; Author: Eric Schulte +;; Maintainer: TEC ;; Keywords: tables, plotting ;; Homepage: https://orgmode.org ;; @@ -144,7 +145,8 @@ and dependent variables." row-vals) (when (>= ind 0) ;; collect values of ind col (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter)) - (cons counter (nth ind row))) table))) + (cons counter (nth ind row))) + table))) (when (or deps (>= ind 0)) ;; remove non-plotting columns (setf deps (delq ind deps)) (setf table (mapcar (lambda (row) @@ -288,14 +290,12 @@ line directly before or after the table." (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 (nth 0 table) 'hline) (nth 1 table) - (nth 0 table))))) + (table (org-table-collapse-header (org-table-to-lisp))) + (num-cols (length (car 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 + (plist-put params :labels (car 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)) @@ -308,26 +308,20 @@ line directly before or after the table." (`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 (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) - (plist-put params :timeind t) - ;; 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)) - (plist-put params :textind t))))) + ;; Check type of ind column (timestamp? text?) + (when (eq `2d (plist-get params :plot-type)) + (let* ((ind (1- (plist-get params :ind))) + (ind-column (mapcar (lambda (row) (nth ind row)) table))) + (cond ((< ind 0) nil) ; ind is implicit + ((cl-every (lambda (el) + (string-match org-ts-regexp3 el)) + ind-column) + (plist-put params :timeind t)) ; ind holds timestamps + ((or (string= (plist-get params :with) "hist") + (cl-notevery (lambda (el) + (string-match org-table-number-regexp el)) + ind-column)) + (plist-put params :textind t))))) ; ind holds text ;; Write script. (with-temp-buffer (if (plist-get params :script) ; user script diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 0ff0e401d27..4bc7cee31fc 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -191,7 +191,7 @@ Example: :working-suffix \".org\" :base-url \"https://orgmode.org/worg/\" :working-directory \"/home/user/org/Worg/\") - (\"http://localhost/org-notes/\" + (\"localhost org-notes/\" :online-suffix \".html\" :working-suffix \".org\" :base-url \"http://localhost/org/\" @@ -202,12 +202,17 @@ Example: :working-directory \"~/site/content/post/\" :online-suffix \".html\" :working-suffix \".md\" - :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\"))))) + :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\"))) + (\"GNU emacs OpenGrok\" + :base-url \"https://opengrok.housegordon.com/source/xref/emacs/\" + :working-directory \"~/dev/gnu-emacs/\"))) - - The last line tells `org-protocol-open-source' to open - /home/user/org/index.php, if the URL cannot be mapped to an existing - file, and ends with either \"org\" or \"org/\". + The :rewrites line of \"localhost org-notes\" entry tells + `org-protocol-open-source' to open /home/user/org/index.php, + if the URL cannot be mapped to an existing file, and ends with + either \"org\" or \"org/\". The \"GNU emacs OpenGrok\" entry + does not include any suffix properties, allowing local source + file to be opened as found by OpenGrok. Consider using the interactive functions `org-protocol-create' and `org-protocol-create-for-org' to help you filling this variable with valid contents." @@ -278,7 +283,7 @@ This should be a single regexp string." :group 'org-protocol :version "24.4" :package-version '(Org . "8.0") - :type 'string) + :type 'regexp) ;;; Helper functions: @@ -545,11 +550,12 @@ The location for a browser's bookmark should look like this: ;; ending than strip-suffix here: (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f))) (start-pos (+ (string-match wsearch f1) (length base-url))) - (end-pos (string-match - (regexp-quote strip-suffix) f1)) + (end-pos (if strip-suffix + (string-match (regexp-quote strip-suffix) f1) + (length f1))) ;; We have to compare redirects without suffix below: (f2 (concat wdir (substring f1 start-pos end-pos))) - (the-file (concat f2 add-suffix))) + (the-file (if add-suffix (concat f2 add-suffix) f2))) ;; Note: the-file may still contain `%C3' et al here because browsers ;; tend to encode `ä' in URLs to `%25C3' - `%25' being `%'. @@ -617,13 +623,13 @@ CLIENT is ignored." (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))) - (new-style (string= (match-string 1 fname) "?"))) + (new-style (string-match "/*?" (match-string 1 fname)))) (when (plist-get (cdr prolist) :kill-client) (message "Greedy org-protocol handler. Killing client.") (server-edit)) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el new file mode 100644 index 00000000000..2a3fad53e80 --- /dev/null +++ b/lisp/org/org-refile.el @@ -0,0 +1,742 @@ +;;; org-refile.el --- Refile Org Subtrees -*- lexical-binding: t; -*- + +;; Copyright (C) 2010-2020 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; +;; 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 . + +;;; Commentary: + +;; Org Refile allows you to refile subtrees to various locations. + +;;; Code: + +(require 'org) + +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) + +(defgroup org-refile nil + "Options concerning refiling entries in Org mode." + :tag "Org Refile" + :group 'org) + +(defcustom org-log-refile nil + "Information to record when a task is refiled. + +Possible values are: + +nil Don't add anything +time Add a time stamp to the task +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologrefile + #+STARTUP: logrefile + #+STARTUP: lognoterefile + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords. + +When bulk-refiling, e.g., from the agenda, the value `note' is +forbidden and will temporarily be changed to `time'." + :group 'org-refile + :group 'org-progress + :version "24.1" + :type '(choice + (const :tag "No logging" nil) + (const :tag "Record timestamp" time) + (const :tag "Record timestamp with note." note))) + +(defcustom org-refile-targets nil + "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 + a file name or a list of file names. If you use `org-agenda-files' for + that, all agenda files will be scanned for targets. Nil means consider + headings in the current buffer. +- A specification of how to find candidate refile targets. This may be + any of: + - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. + This tag has to be present in all target headlines, inheritance will + not be considered. + - a cons cell (:todo . \"KEYWORD\") to identify refile targets by + todo keyword. + - a cons cell (:regexp . \"REGEXP\") with a regular expression matching + headlines that are refiling targets. + - a cons cell (:level . N). Any headline of level N is considered a target. + Note that, when `org-odd-levels-only' is set, level corresponds to + order in hierarchy, not to the number of stars. + - a cons cell (:maxlevel . N). Any headline with level <= N is a target. + Note that, when `org-odd-levels-only' is set, level corresponds to + order in hierarchy, not to the number of stars. + +Each element of this list generates a set of possible targets. +The union of these sets is presented (with completion) to +the user by `org-refile'. + +You can set the variable `org-refile-target-verify-function' to a function +to verify each headline found by the simple criteria above. + +When this variable is nil, all top-level headlines in the current buffer +are used, equivalent to the value `((nil . (:level . 1))'." + :group 'org-refile + :type '(repeat + (cons + (choice :value org-agenda-files + (const :tag "All agenda files" org-agenda-files) + (const :tag "Current buffer" nil) + (function) (variable) (file)) + (choice :tag "Identify target headline by" + (cons :tag "Specific tag" (const :value :tag) (string)) + (cons :tag "TODO keyword" (const :value :todo) (string)) + (cons :tag "Regular expression" (const :value :regexp) (regexp)) + (cons :tag "Level number" (const :value :level) (integer)) + (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) + +(defcustom org-refile-target-verify-function nil + "Function to verify if the headline at point should be a refile target. +The function will be called without arguments, with point at the +beginning of the headline. It should return t and leave point +where it is if the headline is a valid target for refiling. + +If the target should not be selected, the function must return nil. +In addition to this, it may move point to a place from where the search +should be continued. For example, the function may decide that the entire +subtree of the current entry should be excluded and move point to the end +of the subtree." + :group 'org-refile + :type '(choice + (const nil) + (function))) + +(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 \\[org-refile]' or, +if you find that easier, \ +`\\[universal-argument] \\[universal-argument] \\[universal-argument] \ +\\[org-refile]'." + :group 'org-refile + :version "24.1" + :type 'boolean) + +(defcustom org-refile-use-outline-path nil + "Non-nil means provide refile targets as paths. +So a level 3 headline will be available as level1/level2/level3. + +When the value is `file', also include the file name (without directory) +into the path. In this case, you can also stop the completion after +the file name, to get entries inserted as top level in the file. + +When `full-file-path', include the full file path. + +When `buffer-name', use the buffer name." + :group 'org-refile + :type '(choice + (const :tag "Not" nil) + (const :tag "Yes" t) + (const :tag "Start with file name" file) + (const :tag "Start with full file path" full-file-path) + (const :tag "Start with buffer name" buffer-name))) + +(defcustom org-outline-path-complete-in-steps t + "Non-nil means complete the outline path in hierarchical steps. +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) + +(defcustom org-refile-allow-creating-parent-nodes nil + "Non-nil means allow the creation of new nodes as refile targets. +New nodes are then created by adding \"/new node name\" to the completion +of an existing node. When the value of this variable is `confirm', +new node creation must be confirmed by the user (recommended). +When nil, the completion must match an existing entry. + +Note that, if the new heading is not seen by the criteria +listed in `org-refile-targets', multiple instances of the same +heading would be created by trying again to file under the new +heading." + :group 'org-refile + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Prompt for confirmation" confirm))) + +(defcustom org-refile-active-region-within-subtree nil + "Non-nil means also refile active region within a subtree. + +By default `org-refile' doesn't allow refiling regions if they +don't contain a set of subtrees, but it might be convenient to +do so sometimes: in that case, the first line of the region is +converted to a headline before refiling." + :group 'org-refile + :version "24.1" + :type 'boolean) + +(defvar org-refile-target-table nil + "The list of refile targets, created by `org-refile'.") + +(defvar org-refile-cache nil + "Cache for refile targets.") + +(defvar org-refile-markers nil + "All the markers used for caching refile locations.") + +;; Add org refile commands to the main org menu +(mapc (lambda (i) (easy-menu-add-item + org-org-menu + '("Edit Structure") i)) + '(["Refile Subtree" org-refile (org-in-subtree-not-table-p)] + ["Refile and copy Subtree" org-copy (org-in-subtree-not-table-p)])) + +(defun org-refile-marker (pos) + "Get a new refile marker, but only if caching is in use." + (if (not org-refile-use-cache) + pos + (let ((m (make-marker))) + (move-marker m pos) + (push m org-refile-markers) + m))) + +(defun org-refile-cache-clear () + "Clear the refile cache and disable all the 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")) + +(defun org-refile-cache-check-set (set) + "Check if all the markers in the cache still have live buffers." + (let (marker) + (catch 'exit + (while (and set (setq marker (nth 3 (pop set)))) + ;; If `org-refile-use-outline-path' is 'file, marker may be nil + (when (and marker (null (marker-buffer marker))) + (message "Please regenerate the refile cache with `C-0 C-c C-w'") + (sit-for 3) + (throw 'exit nil))) + t))) + +(defun org-refile-cache-put (set &rest identifiers) + "Push the refile targets SET into the cache, under IDENTIFIERS." + (let* ((key (sha1 (prin1-to-string identifiers))) + (entry (assoc key org-refile-cache))) + (if entry + (setcdr entry set) + (push (cons key set) org-refile-cache)))) + +(defun org-refile-cache-get (&rest identifiers) + "Retrieve the cached value for refile targets given by IDENTIFIERS." + (cond + ((not org-refile-cache) nil) + ((not org-refile-use-cache) (org-refile-cache-clear) nil) + (t + (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) + org-refile-cache)))) + (and set (org-refile-cache-check-set set) set))))) + +(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 files desc descre) + (message "Getting targets...") + (with-current-buffer (or default-buffer (current-buffer)) + (dolist (entry entries) + (setq files (car entry) desc (cdr entry)) + (cond + ((null files) (setq files (list (current-buffer)))) + ((eq files 'org-agenda-files) + (setq files (org-agenda-files 'unrestricted))) + ((and (symbolp files) (fboundp files)) + (setq files (funcall files))) + ((and (symbolp files) (boundp files)) + (setq files (symbol-value files)))) + (when (stringp files) (setq files (list files))) + (cond + ((eq (car desc) :tag) + (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) + ((eq (car desc) :todo) + (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) + ((eq (car desc) :regexp) + (setq descre (cdr desc))) + ((eq (car desc) :level) + (setq descre (concat "^\\*\\{" (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + ((eq (car desc) :maxlevel) + (setq descre (concat "^\\*\\{1," (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \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)) + (or + (setq tgs (org-refile-cache-get (buffer-file-name) descre)) + (progn + (when (bufferp f) + (setq f (buffer-file-name (buffer-base-buffer f)))) + (setq f (and f (expand-file-name f))) + (when (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'buffer-name) + (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'full-file-path) + (push (list (file-truename (buffer-file-name (buffer-base-buffer))) 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 + #'identity + (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)))) + (`buffer-name + (list (buffer-name + (buffer-base-buffer)))) + (_ nil)) + (mapcar (lambda (s) (replace-regexp-in-string + "/" "\\/" s nil t)) + (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") + (delete-dups (nreverse targets)))) + +(defvar org-refile-history nil + "History for refiling operations.") + +(defvar org-after-refile-insert-hook nil + "Hook run after `org-refile' has inserted its stuff at the new location. +Note that this is still *before* the stuff will be removed from +the *old* location.") + +(defvar org-refile-keep nil + "Non-nil means `org-refile' will copy instead of refile.") + +(define-obsolete-function-alias 'org-copy 'org-refile-copy) + +;;;###autoload +(defun org-refile-copy () + "Like `org-refile', but preserve the refiled subtree." + (interactive) + (let ((org-refile-keep t)) + (org-refile nil nil nil "Copy"))) + +(defvar org-capture-last-stored-marker) + +;;;###autoload +(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. + +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 a `\\[universal-argument]' ARG, the command will only visit the target \ +location +and not actually move anything. + +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. + +With a numeric prefix argument of `3', emulate `org-refile-keep' +being set to t and copy to the target location, don't move it. +Beware that keeping refiled entries may result in duplicated ID +properties. + +RFLOC can be a refile location obtained in a different way. It +should be a list with the following 4 elements: + +1. Name - an identifier for the refile location, typically the +headline text +2. File - the file the refile location is in +3. nil - used for generating refile location candidates, not +needed when passing RFLOC +4. Position - the position in the specified file of the +headline to refile under + +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'. + +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 arg '(0 (64))) + (org-refile-cache-clear) + (let* ((actionmsg (cond (msg msg) + ((equal arg 3) "Refile (and keep)") + (t "Refile"))) + (regionp (org-region-active-p)) + (region-start (and regionp (region-beginning))) + (region-end (and regionp (region-end))) + (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) + (beginning-of-line) + (setq region-start (point)) + (unless (or (org-kill-is-subtree-p + (buffer-substring region-start region-end)) + (prog1 org-refile-active-region-within-subtree + (let ((s (point-at-eol))) + (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 arg '(16)) + (org-refile-goto-last-stored) + (when (or + (and (equal arg 2) + org-clock-hd-marker (marker-buffer org-clock-hd-marker) + (prog1 + (setq it (list (or org-clock-heading "running clock") + (buffer-file-name + (marker-buffer org-clock-hd-marker)) + "" + (marker-position org-clock-hd-marker))) + (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-link-bracket-re + "\\2" + (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) + pos (nth 3 it)) + (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 arg (not (equal arg 3))) + (progn + (pop-to-buffer-same-window nbuf) + (goto-char (cond (pos) + ((org-notes-order-reversed-p) (point-min)) + (t (point-max)))) + (org-show-context 'org-goto)) + (if regionp + (progn + (org-kill-new (buffer-substring region-start region-end)) + (org-save-markers-in-region region-start region-end)) + (org-copy-subtree 1 nil t)) + (with-current-buffer (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (setq reversed (org-notes-order-reversed-p)) + (org-with-wide-buffer + (if pos + (progn + (goto-char pos) + (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) + ;; Record information, according to `org-log-refile'. + ;; Do not prompt for a note when refiling multiple + ;; headlines, however. Simply add a time stamp. + (cond + ((not org-log-refile)) + (regionp + (org-map-region + (lambda () (org-add-log-setup 'refile nil nil 'time)) + (point) + (+ (point) (- region-end region-start)))) + (t + (org-add-log-setup 'refile nil nil org-log-refile))) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-align-tags))) + (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))) + (org-preserve-local-variables + (delete-region + (and (org-back-to-heading t) (point)) + (min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))) + (when (featurep 'org-inlinetask) + (org-inlinetask-remove-END-maybe)) + (setq org-markers-to-move nil) + (message "%s to \"%s\" in file %s: done" actionmsg + (car it) file))))))) + +(defun org-refile-goto-last-stored () + "Go to the location where the last refile was stored." + (interactive) + (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) + "When user refile to REFLOC, find the associated target in TBL. +Also check `org-refile-target-table'." + (car (delq + nil + (mapcar + (lambda (r) (or (assoc r tbl) + (assoc r 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) + "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." + (let ((org-refile-targets org-refile-targets) + (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)) + (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 + #'completing-read)) + (extra (if org-refile-use-outline-path "/" "")) + (cbnex (concat (buffer-name) extra)) + (filename (and cfn (expand-file-name cfn))) + (tbl (mapcar + (lambda (x) + (if (and (not (member org-refile-use-outline-path + '(file full-file-path))) + (not (equal filename (nth 1 x)))) + (cons (concat (car x) extra " (" + (file-name-nondirectory (nth 1 x)) ")") + (cdr x)) + (cons (concat (car x) extra) (cdr x)))) + org-refile-target-table)) + (completion-ignore-case t) + cdef + (prompt (concat prompt + (or (and (car org-refile-history) + (concat " (default " (car org-refile-history) ")")) + (and (assoc cbnex tbl) (setq cdef cbnex) + (concat " (default " cbnex ")"))) ": ")) + pa answ parent-target child parent old-hist) + (setq old-hist org-refile-history) + (setq answ (funcall cfunc prompt tbl nil (not new-nodes) + nil 'org-refile-history + (or cdef (concat (car org-refile-history) extra)))) + (if (setq pa (org-refile--get-location answ tbl)) + (let* ((last-refile-loc (car org-refile-history)) + (last-refile-loc-path (concat last-refile-loc extra))) + (org-refile-check-position pa) + (when (or (not org-refile-history) + (not (eq old-hist org-refile-history)) + (not (equal (car pa) last-refile-loc-path))) + (setq org-refile-history + (cons (car pa) (if (assoc last-refile-loc tbl) + org-refile-history + (cdr org-refile-history)))) + (when (or (equal last-refile-loc-path (nth 1 org-refile-history)) + (equal last-refile-loc (nth 1 org-refile-history))) + (pop org-refile-history))) + pa) + (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) + (progn + (setq parent (match-string 1 answ) + child (match-string 2 answ)) + (setq parent-target (org-refile--get-location parent tbl)) + (when (and parent-target + (or (eq new-nodes t) + (and (eq new-nodes 'confirm) + (y-or-n-p (format "Create new node \"%s\"? " + child))))) + (org-refile-new-child parent-target child))) + (user-error "Invalid target location"))))) + +(defun org-refile-check-position (refile-pointer) + "Check if the refile pointer matches the headline to which it points." + (let* ((file (nth 1 refile-pointer)) + (re (nth 2 refile-pointer)) + (pos (nth 3 refile-pointer)) + buffer) + (if (and (not (markerp pos)) (not file)) + (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 + (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." + (unless parent-target + (error "Cannot find parent for new node")) + (let ((file (nth 1 parent-target)) + (pos (nth 3 parent-target)) + level) + (with-current-buffer (or (find-buffer-visiting file) + (find-file-noselect file)) + (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)) + (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))) + +(provide 'org-refile) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-refile.el ends here diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 7876deaba19..28733d0115b 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -148,6 +148,9 @@ the existing edit buffer." "How the source code edit buffer should be displayed. Possible values for this option are: +plain Show edit buffer using `display-buffer'. Users can + further control the display behavior by modifying + `display-buffer-alist' and its relatives. current-window Show edit buffer in the current window, keeping all other windows. split-window-below Show edit buffer below the current window, keeping all @@ -156,10 +159,12 @@ split-window-right Show edit buffer to the right of the current window, keeping all other windows. other-window Use `switch-to-buffer-other-window' to display edit buffer. reorganize-frame Show only two windows on the current frame, the current - window and the edit buffer. When exiting the edit buffer, - return to one window. + window and the edit buffer. other-frame Use `switch-to-buffer-other-frame' to display edit buffer. - Also, when exiting the edit buffer, kill that frame." + Also, when exiting the edit buffer, kill that frame. + +Values that modify the window layout (reorganize-frame, split-window-below, +split-window-right) will restore the layout after exiting the edit buffer." :group 'org-edit-structure :type '(choice (const current-window) @@ -232,11 +237,11 @@ green, respectability. :version "26.1" :package-version '(Org . "9.0")) -(defcustom org-src-tab-acts-natively nil +(defcustom org-src-tab-acts-natively t "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" + :package-version '(Org . "9.4") :group 'org-babel) @@ -276,6 +281,9 @@ issued in the language major mode buffer." (defvar-local org-src--remote nil) (put 'org-src--remote 'permanent-local t) +(defvar-local org-src--saved-temp-window-config nil) +(put 'org-src--saved-temp-window-config 'permanent-local t) + (defvar-local org-src--source-type nil "Type of element being edited, as a symbol.") (put 'org-src--source-type 'permanent-local t) @@ -355,6 +363,12 @@ where BEG and END are buffer positions and CONTENTS is a string." (end (progn (goto-char (org-element-property :end datum)) (search-backward "}" (line-beginning-position) t)))) (list beg end (buffer-substring-no-properties beg end)))) + ((eq type 'latex-fragment) + (let ((beg (org-element-property :begin datum)) + (end (org-with-point-at (org-element-property :end datum) + (skip-chars-backward " \t") + (point)))) + (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))) @@ -469,6 +483,10 @@ 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." + (when (memq org-src-window-setup '(reorganize-frame + split-window-below + split-window-right)) + (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)) @@ -540,6 +558,10 @@ Leave point in edit buffer." (setq org-src-source-file-name source-file-name) ;; Start minor mode. (org-src-mode) + ;; Clear undo information so we cannot undo back to the + ;; initial empty buffer. + (buffer-disable-undo (current-buffer)) + (buffer-enable-undo) ;; Move mark and point in edit buffer to the corresponding ;; location. (if remote @@ -792,9 +814,14 @@ Raise an error when current buffer is not a source editing buffer." (defun org-src-switch-to-buffer (buffer context) (pcase org-src-window-setup + (`plain + (when (eq context 'exit) (quit-restore-window)) + (pop-to-buffer buffer)) (`current-window (pop-to-buffer-same-window buffer)) (`other-window - (switch-to-buffer-other-window buffer)) + (let ((cur-win (selected-window))) + (org-switch-to-buffer-other-window buffer) + (when (eq context 'exit) (quit-restore-window cur-win)))) (`split-window-below (if (eq context 'exit) (delete-window) @@ -912,7 +939,7 @@ A coderef format regexp can only match at the end of a line." ;; 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 ""))))) + (while (search-forward "\n" nil t) (replace-match " "))))) contents 'remote)) ;; Report success. @@ -942,6 +969,46 @@ Throw an error when not at such a table." (table-recognize) t)) +(defun org-edit-latex-fragment () + "Edit LaTeX fragment at point." + (interactive) + (let ((context (org-element-context))) + (unless (and (eq 'latex-fragment (org-element-type context)) + (org-src--on-datum-p context)) + (user-error "Not on a LaTeX fragment")) + (let* ((contents + (buffer-substring-no-properties + (org-element-property :begin context) + (- (org-element-property :end context) + (org-element-property :post-blank context)))) + (delim-length (if (string-match "\\`\\$[^$]" contents) 1 2))) + ;; Make the LaTeX deliminators read-only. + (add-text-properties 0 delim-length + (list 'read-only "Cannot edit LaTeX deliminator" + 'front-sticky t + 'rear-nonsticky t) + contents) + (let ((l (length contents))) + (add-text-properties (- l delim-length) l + (list 'read-only "Cannot edit LaTeX deliminator" + 'front-sticky nil + 'rear-nonsticky nil) + contents)) + (org-src--edit-element + context + (org-src--construct-edit-buffer-name (buffer-name) "LaTeX fragment") + (org-src-get-lang-mode "latex") + (lambda () + ;; Blank lines break things, replace with a single newline. + (while (re-search-forward "\n[ \t]*\n" nil t) (replace-match "\n")) + ;; If within a table a newline would disrupt the structure, + ;; so remove newlines. + (goto-char (point-min)) + (when (org-element-lineage context '(table-cell)) + (while (search-forward "\n" nil t) (replace-match " ")))) + contents)) + t)) + (defun org-edit-latex-environment () "Edit LaTeX environment at point. \\ @@ -1182,8 +1249,11 @@ Throw an error if there is no such buffer." (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))) - + (set-marker end nil) + (when org-src--saved-temp-window-config + (unwind-protect + (set-window-configuration org-src--saved-temp-window-config) + (setq org-src--saved-temp-window-config nil))))) (provide 'org-src) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 49765472558..8dd3f392d2d 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -40,6 +40,8 @@ (require 'org-keys) (declare-function calc-eval "calc" (str &optional separator &rest args)) +(declare-function face-remap-remove-relative "face-remap" (cookie)) +(declare-function face-remap-add-relative "face-remap" (face &rest specs)) (declare-function org-at-timestamp-p "org" (&optional extended)) (declare-function org-delete-backward-char "org" (N)) (declare-function org-element-at-point "org-element" ()) @@ -164,6 +166,12 @@ table, obtained by prompting the user." :tag "Org Table Settings" :group 'org-table) +(defcustom org-table-header-line-p nil + "Activate `org-table-header-line-mode' by default?" + :type 'boolean + :package-version '(Org . "9.4") + :group 'org-table) + (defcustom org-table-default-size "5x2" "The default size for newly created tables, Columns x Rows." :group 'org-table-settings @@ -198,7 +206,7 @@ Other options offered by the customize interface are more restrictive." "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") - (string :tag "Regexp:"))) + (regexp :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 "Fraction of numbers in a column required to make the column align right. @@ -441,6 +449,59 @@ prevents it from hanging Emacs." :type 'integer :package-version '(Org . "8.3")) + +;;; Org table header minor mode +(defun org-table-row-get-visible-string (&optional pos) + "Get the visible string of a table row. +This may be useful when columns have been shrunk." + (save-excursion + (when pos (goto-char pos)) + (goto-char (line-beginning-position)) + (let ((end (line-end-position)) str) + (while (progn (forward-char 1) (< (point) end)) + (let ((ov (car (overlays-at (point))))) + (if (not ov) + (push (char-to-string (char-after)) str) + (push (overlay-get ov 'display) str) + (goto-char (1- (overlay-end ov)))))) + (format "|%s" (mapconcat #'identity (reverse str) ""))))) + +(defvar-local org-table-header-overlay nil) +(defun org-table-header-set-header () + "Display the header of the table at point." + (when (overlayp org-table-header-overlay) + (delete-overlay org-table-header-overlay)) + (let* ((ws (window-start)) + (beg (save-excursion + (goto-char (org-table-begin)) + (while (or (org-at-table-hline-p) + (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>")) + (move-beginning-of-line 2)) + (point))) + (end (save-excursion (goto-char beg) (point-at-eol)))) + (if (pos-visible-in-window-p beg) + (when (overlayp org-table-header-overlay) + (delete-overlay org-table-header-overlay)) + (setq org-table-header-overlay + (make-overlay ws (+ ws (- end beg)))) + (org-overlay-display + org-table-header-overlay + (org-table-row-get-visible-string beg) + 'org-table-header)))) + +;;;###autoload +(define-minor-mode org-table-header-line-mode + "Display the first row of the table at point in the header line." + nil " TblHeader" nil + (unless (eq major-mode 'org-mode) + (user-error "Cannot turn org table header mode outside org-mode buffers")) + (if org-table-header-line-mode + (add-hook 'post-command-hook #'org-table-header-set-header nil t) + (when (overlayp org-table-header-overlay) + (delete-overlay org-table-header-overlay) + (setq org-table-header-overlay nil)) + (remove-hook 'post-command-hook #'org-table-header-set-header t))) + ;;; Regexps Constants @@ -860,19 +921,22 @@ nil When nil, the command tries to be smart and figure out the 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 - - when each line contains a comma, assume CSV material - - else, assume one or more SPACE characters as separator. +- when each line contains a TAB, assume TAB-separated material; +- when each line contains a comma, assume CSV material; +- else, assume one or more SPACE characters as separator. When non-nil, 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 -(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." +- (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." (interactive "f\nP") + (when (and (called-interactively-p 'any) + (not (string-match-p (rx "." (or "txt" "tsv" "csv") eos) file))) + (user-error "Cannot import such file")) (unless (bolp) (insert "\n")) (let ((beg (point)) (pm (point-max))) @@ -1181,7 +1245,7 @@ value." (save-excursion (let* ((pos (point)) (col (org-table-current-column)) - (cname (car (rassoc (int-to-string col) org-table-column-names))) + (cname (car (rassoc (number-to-string col) org-table-column-names))) (name (car (rassoc (list (count-lines org-table-current-begin-pos (line-beginning-position)) col) @@ -1290,25 +1354,20 @@ However, when FORCE is non-nil, create new columns if necessary." (while (< (point) end) (unless (org-at-table-hline-p) (org-table-goto-column col t) - (unless (search-forward "|" (line-end-position) t 2) - ;; Add missing vertical bar at the end of the row. - (end-of-line) - (insert "|")) - (insert " |")) + (insert "|")) (forward-line))) - (org-table-goto-column (1+ col)) + (org-table-goto-column col) (org-table-align) ;; Shift appropriately stored shrunk column numbers, then hide the ;; columns again. - (org-table--shrink-columns (mapcar (lambda (c) (if (<= c col) c (1+ c))) + (org-table--shrink-columns (mapcar (lambda (c) (if (< c col) c (1+ c))) shrunk-columns) beg end) (set-marker end nil) ;; Fix TBLFM formulas, if desirable. (when (or (not org-table-fix-formulas-confirm) (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas "$" nil (1- col) 1) - (org-table-fix-formulas "$LR" nil (1- col) 1)))) + (org-table-fix-formulas "$" nil (1- col) 1)))) (defun org-table-find-dataline () "Find a data line in the current table, which is needed for column commands. @@ -1431,6 +1490,8 @@ Swap with anything in target cell." (interactive) (unless (org-at-table-p) (user-error "Not at a table")) (org-table-find-dataline) + (when (save-excursion (skip-chars-forward " \t") (eolp)) + (search-backward "|")) ;snap into last column (org-table-check-inside-data-field nil t) (let* ((col (org-table-current-column)) (beg (org-table-begin)) @@ -1446,7 +1507,6 @@ Swap with anything in target cell." (and (looking-at "|[^|\n]+|") (replace-match "|"))) (forward-line))) - (org-table-goto-column (max 1 (1- col))) (org-table-align) ;; Shift appropriately stored shrunk column numbers, then hide the ;; columns again. @@ -1458,9 +1518,7 @@ Swap with anything in target cell." (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)))) + "$" (list (cons (number-to-string col) "INVALID")) col -1 col)))) ;;;###autoload (defun org-table-move-column-right () @@ -1521,11 +1579,7 @@ Swap with anything in target cell." (funcall org-table-fix-formulas-confirm "Fix formulas? ")) (org-table-fix-formulas "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))) - (org-table-fix-formulas - "$LR" (list - (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))))))) + (cons (number-to-string colpos) (number-to-string col)))))))) ;;;###autoload (defun org-table-move-row-down () @@ -1958,9 +2012,9 @@ toggle `org-table-follow-field-mode'." (coord (if (eq org-table-use-standard-references t) (concat (org-number-to-letters (org-table-current-column)) - (int-to-string (org-table-current-dline))) - (concat "@" (int-to-string (org-table-current-dline)) - "$" (int-to-string (org-table-current-column))))) + (number-to-string (org-table-current-dline))) + (concat "@" (number-to-string (org-table-current-dline)) + "$" (number-to-string (org-table-current-column))))) (field (org-table-get-field)) (cw (current-window-configuration)) p) @@ -2005,7 +2059,7 @@ the table and kill the editing buffer." text) (goto-char (point-min)) (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) - (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) + (while (re-search-forward "[ \t]*\n[ \t\n]*" nil t) (replace-match " ")) (setq text (org-trim (buffer-string))) (set-window-configuration cw) @@ -2060,7 +2114,7 @@ When NAMED is non-nil, look for a named equation." (org-table-current-column))) (scol (cond ((not named) (format "$%d" (org-table-current-column))) - ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name) + (name) (t ref))) (name (or name ref)) (org-table-may-need-update nil) @@ -2193,11 +2247,10 @@ For all numbers larger than LIMIT, shift them by DELTA." (save-excursion (goto-char (org-table-end)) (while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) - (let ((msg "The formulas in #+TBLFM have been updated") - (re (concat key "\\([0-9]+\\)")) + (let ((re (concat key "\\([0-9]+\\)")) (re2 (when remove - (if (or (equal key "$") (equal key "$LR")) + (if (equal key "$") (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" (regexp-quote key) remove) (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) @@ -2215,11 +2268,10 @@ For all numbers larger than LIMIT, shift them by DELTA." (setq s (match-string 1) n (string-to-number s)) (cond ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t) - (message msg)) + (replace-match (concat key (cdr a)) t t)) ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t) - (message msg)))))) + (replace-match (concat key (number-to-string (+ n delta))) t t))))) + (message "The formulas in #+TBLFM have been updated")) (forward-line)))) ;;;###autoload @@ -2547,7 +2599,8 @@ location of point." ev (if (numberp ev) (number-to-string ev) ev) ev (if duration (org-table-time-seconds-to-string (string-to-number ev) - duration-output-format) ev)) + duration-output-format) + ev)) ;; Use <...> time-stamps so that Calc can handle them. (setq form @@ -2578,27 +2631,29 @@ location of point." ev))) (when org-table-formula-debug - (with-output-to-temp-buffer "*Substitution History*" - (princ (format "Substitution history of formula + (let ((wcf (current-window-configuration))) + (with-output-to-temp-buffer "*Substitution History*" + (princ (format "Substitution history of formula Orig: %s $xyz-> %s @r$c-> %s $1-> %s\n" orig formula form0 form)) - (if (consp ev) - (princ (format " %s^\nError: %s" - (make-string (car ev) ?\-) (nth 1 ev))) - (princ (format "Result: %s\nFormat: %s\nFinal: %s" - ev (or fmt "NONE") - (if fmt (format fmt (string-to-number ev)) ev))))) - (setq bw (get-buffer-window "*Substitution History*")) - (org-fit-window-to-buffer bw) - (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 (consp ev) + (princ (format " %s^\nError: %s" + (make-string (car ev) ?\-) (nth 1 ev))) + (princ (format "Result: %s\nFormat: %s\nFinal: %s" + ev (or fmt "NONE") + (if fmt (format fmt (string-to-number ev)) ev))))) + (setq bw (get-buffer-window "*Substitution History*")) + (org-fit-window-to-buffer bw) + (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 "") + (set-window-configuration wcf)))) (when (consp ev) (setq fmt nil ev "#ERROR")) (org-table-justify-field-maybe (format org-table-formula-field-format @@ -3099,7 +3154,7 @@ function assumes the table is already analyzed (i.e., using (let ((lhs (car e)) (rhs (cdr e))) (cond - ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) + ((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) @@ -3287,7 +3342,6 @@ Parameters get priority." (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 @@ -3768,14 +3822,16 @@ FACE, when non-nil, for the highlight." (defun org-table-toggle-coordinate-overlays () "Toggle the display of Row/Column numbers in tables." (interactive) - (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Tables Row/Column numbers display turned %s" - (if org-table-overlay-coordinates "on" "off")) - (when (and (org-at-table-p) org-table-overlay-coordinates) - (org-table-align)) - (unless org-table-overlay-coordinates - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil))) + (if (not (org-at-table-p)) + (user-error "Not on a table") + (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) + (when (and (org-at-table-p) org-table-overlay-coordinates) + (org-table-align)) + (unless org-table-overlay-coordinates + (mapc 'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil)) + (message "Tables Row/Column numbers display turned %s" + (if org-table-overlay-coordinates "on" "off")))) ;;;###autoload (defun org-table-toggle-formula-debugger () @@ -4239,7 +4295,8 @@ extension of the given file name, and finally on the variable (and (string-match-p fileext f) f)) formats))) org-table-export-default-format) - t t) t t))) + t t) + t t))) (setq format (org-completing-read "Format: " formats nil nil deffmt-readable)))) @@ -4247,9 +4304,7 @@ extension of the given file name, and finally on the variable (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))))) + (table (org-table-to-lisp))) (unless (fboundp transform) (user-error "No such transformation function %s" transform)) (let (buf) @@ -4293,78 +4348,79 @@ FIELD is a string. WIDTH is a number. ALIGN is either \"c\", (move-marker org-table-aligned-end-marker end) (goto-char beg) (org-table-with-shrunk-columns - (let* ((indent (progn (looking-at "[ \t]*") (match-string 0))) - ;; Table's rows as lists of fields. Rules are replaced - ;; by nil. Trailing spaces are removed. - (fields (mapcar - (lambda (l) - (and (not (string-match-p org-table-hline-regexp l)) - (org-split-string l "[ \t]*|[ \t]*"))) - (split-string (buffer-substring beg end) "\n" t))) - ;; Compute number of columns. If the table contains no - ;; field, create a default table and bail out. - (columns-number - (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"))) + (let* ((table (org-table-to-lisp)) + (rows (remq 'hline table)) (widths nil) - (alignments nil)) - ;; Compute alignment and width for each column. - (dotimes (i columns-number) - (let* ((max-width 1) - (fixed-align? nil) - (numbers 0) - (non-empty 0)) - (dolist (row fields) - (let ((cell (or (nth i row) ""))) - (setq max-width (max max-width (org-string-width cell))) - (cond (fixed-align? nil) - ((equal cell "") nil) - ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell) - (setq fixed-align? (match-string 1 cell))) - (t - (cl-incf non-empty) - (when (string-match-p org-table-number-regexp cell) - (cl-incf numbers)))))) - (push max-width widths) - (push (cond - (fixed-align?) - ((>= numbers (* org-table-number-fraction non-empty)) "r") - (t "l")) - alignments))) - (setq widths (nreverse widths)) - (setq alignments (nreverse alignments)) + (alignments nil) + (columns-number 1)) + (if (null rows) + ;; Table contains only horizontal rules. Compute the + ;; number of columns anyway, and choose an arbitrary width + ;; and alignment. + (let ((end (line-end-position))) + (save-excursion + (while (search-forward "+" end t) + (cl-incf columns-number))) + (setq widths (make-list columns-number 1)) + (setq alignments (make-list columns-number "l"))) + ;; Compute alignment and width for each column. + (setq columns-number (apply #'max (mapcar #'length rows))) + (dotimes (i columns-number) + (let ((max-width 1) + (fixed-align? nil) + (numbers 0) + (non-empty 0)) + (dolist (row rows) + (let ((cell (or (nth i row) ""))) + (setq max-width (max max-width (org-string-width cell))) + (cond (fixed-align? nil) + ((equal cell "") nil) + ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell) + (setq fixed-align? (match-string 1 cell))) + (t + (cl-incf non-empty) + (when (string-match-p org-table-number-regexp cell) + (cl-incf numbers)))))) + (push max-width widths) + (push (cond + (fixed-align?) + ((>= numbers (* org-table-number-fraction non-empty)) "r") + (t "l")) + alignments))) + (setq widths (nreverse widths)) + (setq alignments (nreverse alignments))) ;; Store alignment of this table, for later editing of single ;; fields. (setq org-table-last-alignment alignments) (setq org-table-last-column-widths widths) ;; Build new table rows. Only replace rows that actually ;; changed. - (dolist (row fields) - (let ((previous (buffer-substring (point) (line-end-position))) - (new - (format "%s|%s|" - indent - (if (null row) ;horizontal rule - (mapconcat (lambda (w) (make-string (+ 2 w) ?-)) - widths - "+") - (let ((cells ;add missing fields - (append row - (make-list (- columns-number - (length row)) - "")))) - (mapconcat #'identity - (cl-mapcar #'org-table--align-field - cells - widths - alignments) - "|")))))) - (if (equal new previous) - (forward-line) - (insert new "\n") - (delete-region (point) (line-beginning-position 2))))) + (let ((rule (and (memq 'hline table) + (mapconcat (lambda (w) (make-string (+ 2 w) ?-)) + widths + "+"))) + (indent (progn (looking-at "[ \t]*|") (match-string 0)))) + (dolist (row table) + (let ((previous (buffer-substring (point) (line-end-position))) + (new + (concat indent + (if (eq row 'hline) rule + (let* ((offset (- columns-number (length row))) + (fields (if (= 0 offset) row + ;; Add missing fields. + (append row + (make-list offset ""))))) + (mapconcat #'identity + (cl-mapcar #'org-table--align-field + fields + widths + alignments) + "|"))) + "|"))) + (if (equal new previous) + (forward-line) + (insert new "\n") + (delete-region (point) (line-beginning-position 2)))))) (set-marker end nil) (when org-table-overlay-coordinates (org-table-overlay-coordinates)) (setq org-table-may-need-update nil)))))) @@ -4406,7 +4462,7 @@ Optional argument NEW may specify text to replace the current field content." ((not new) (concat (org-table--align-field field width align) "|")) - ((<= (org-string-width new) width) + ((and width (<= (org-string-width new) width)) (concat (org-table--align-field new width align) "|")) (t @@ -4758,7 +4814,7 @@ This function sets up the following dynamically scoped variables: (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))))) + (push (cons name (number-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\\)\\>" @@ -4817,23 +4873,10 @@ This function sets up the following dynamically scoped variables: ;; 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)))))) + (setq org-table-current-ncol + (length (org-split-string + (buffer-substring (line-beginning-position) (line-end-position)) + "[ \t]*|[ \t]*")))))) (defun org-table--force-dataline () "Move point to the closest data line in a table. @@ -5039,66 +5082,66 @@ When LOCAL is non-nil, show references for the table at point." (put 'orgtbl-mode :menu-tag "Org Table Mode") (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" - '("OrgTbl" - ["Create or convert" org-table-create-or-convert-from-region - :active (not (org-at-table-p)) :keys "C-c |" ] - "--" - ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] - ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] - ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] - ["Next Row" org-return :active (org-at-table-p) :keys "RET"] - "--" - ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] - ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] - ["Copy Field from Above" - org-table-copy-down :active (org-at-table-p) :keys "S-RET"] - "--" - ("Column" - ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-"] - ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-"] - ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-"] - ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-"]) - ("Row" - ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-"] - ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-"] - ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-"] - ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-"] - ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"] - "--" - ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) - ("Rectangle" - ["Copy Rectangle" org-copy-special :active (org-at-table-p)] - ["Cut Rectangle" org-cut-special :active (org-at-table-p)] - ["Paste Rectangle" org-paste-special :active (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) - "--" - ("Radio tables" - ["Insert table template" orgtbl-insert-radio-table - (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)] - ["Comment/uncomment table" orgtbl-toggle-comment t]) - "--" - ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] - ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] - ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] - ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] - ["Debug Formulas" - org-table-toggle-formula-debugger :active (org-at-table-p) - :keys "C-c {" - :style toggle :selected org-table-formula-debug] - ["Show Col/Row Numbers" - 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"]))) + '("OrgTbl" + ["Create or convert" org-table-create-or-convert-from-region + :active (not (org-at-table-p)) :keys "C-c |" ] + "--" + ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] + ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] + ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] + ["Next Row" org-return :active (org-at-table-p) :keys "RET"] + "--" + ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] + ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] + ["Copy Field from Above" + org-table-copy-down :active (org-at-table-p) :keys "S-RET"] + "--" + ("Column" + ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-"] + ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-"] + ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-"] + ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-"]) + ("Row" + ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-"] + ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-"] + ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-"] + ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-"] + ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"] + "--" + ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) + ("Rectangle" + ["Copy Rectangle" org-copy-special :active (org-at-table-p)] + ["Cut Rectangle" org-cut-special :active (org-at-table-p)] + ["Paste Rectangle" org-paste-special :active (org-at-table-p)] + ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) + "--" + ("Radio tables" + ["Insert table template" orgtbl-insert-radio-table + (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)] + ["Comment/uncomment table" orgtbl-toggle-comment t]) + "--" + ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] + ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] + ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] + ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] + ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] + ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] + ["Sum Column/Rectangle" org-table-sum + :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] + ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] + ["Debug Formulas" + org-table-toggle-formula-debugger :active (org-at-table-p) + :keys "C-c {" + :style toggle :selected org-table-formula-debug] + ["Show Col/Row Numbers" + 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"]))) ;;;###autoload (define-minor-mode orgtbl-mode @@ -5129,15 +5172,13 @@ When LOCAL is non-nil, show references for the table at point." orgtbl-line-start-regexp)) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu)) + (org-restart-font-lock))) (t (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) (remove-hook 'before-change-functions 'org-before-change-function t) (when (fboundp 'font-lock-remove-keywords) (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) (force-mode-line-update 'all)))) (defun orgtbl-make-binding (fun n &rest keys) @@ -5147,7 +5188,7 @@ command name. KEYS are keys that should be checked in for a command to execute outside of tables." (eval (list 'defun - (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) + (intern (concat "orgtbl-hijacker-command-" (number-to-string n))) '(arg) (concat "In tables, run `" (symbol-name fun) "'.\n" "Outside of tables, run the binding of `" @@ -5401,17 +5442,56 @@ a radio table." ;;;###autoload (defun org-table-to-lisp (&optional txt) "Convert the table at point to a Lisp structure. + 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 (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]*")))) + (if txt + (with-temp-buffer + (insert txt) + (goto-char (point-min)) + (org-table-to-lisp)) + (save-excursion + (goto-char (org-table-begin)) + (let ((table nil)) + (while (re-search-forward "\\=[ \t]*|" nil t) + (let ((row nil)) + (if (looking-at "-") + (push 'hline table) + (while (not (progn (skip-chars-forward " \t") (eolp))) + (push (buffer-substring + (point) + (progn (re-search-forward "[ \t]*\\(|\\|$\\)") + (match-beginning 0))) + row)) + (push (nreverse row) table))) + (forward-line)) + (nreverse table))))) + +(defun org-table-collapse-header (table &optional separator max-header-lines) + "Collapse the lines before 'hline into a single header. + +The given TABLE is a list of lists as returned by `org-table-to-lisp'. +The leading lines before the first `hline' symbol are considered +forming the table header. This function collapses all leading header +lines into a single header line, followed by the `hline' symbol, and +the rest of the TABLE. Header cells are glued together with a space, +or the given SEPARATOR." + (while (eq (car table) 'hline) (pop table)) + (let* ((separator (or separator " ")) + (max-header-lines (or max-header-lines 4)) + (trailer table) + (header-lines (cl-loop for line in table + until (eq 'hline line) + collect (pop trailer)))) + (if (and trailer (<= (length header-lines) max-header-lines)) + (cons (apply #'cl-mapcar + (lambda (&rest x) + (org-trim + (mapconcat #'identity x separator))) + header-lines) + trailer) + table))) (defun orgtbl-send-table (&optional maybe) "Send a transformed version of table at point to the receiver position. @@ -5423,9 +5503,7 @@ for this table." ;; when non-interactive, we assume align has just happened. (when (called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) - (table (org-table-to-lisp - (buffer-substring-no-properties (org-table-begin) - (org-table-end)))) + (table (org-table-to-lisp)) (ntbl 0)) (unless dests (if maybe (throw 'exit nil) @@ -6096,7 +6174,7 @@ which will prompt for the width." ((numberp ask) ask) (t 12)))) ;; Skip any hline a the top of table. - (while (eq (car table) 'hline) (setq table (cdr table))) + (while (eq (car table) 'hline) (pop table)) ;; Skip table header if any. (dolist (x (or (cdr (memq 'hline table)) table)) (when (consp x) @@ -6122,7 +6200,7 @@ which will prompt for the width." ;; 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 +;; See https://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) @@ -6136,7 +6214,7 @@ which will prompt for the width." 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 + ;; https://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")) diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 9ae2700549c..eac6b35fd50 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -4,7 +4,7 @@ ;; ;; Author: Rasmus Pank Roulund ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org +;; Homepage: https://orgmode.org ;; ;; This file is part of GNU Emacs. ;; @@ -122,7 +122,7 @@ Go through `org-structure-template-alist' and (special (member name '("src" "export")))) (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name)) `(,(format "#+begin_%s%s" name (if special " " "")) - ,(when special 'p) '> n '> ,(unless special 'p) n + ,(when special 'p) '> n ,(unless special 'p) n ,(format "#+end_%s" (car (split-string name " "))) >) key diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index a1eb5e4a7a7..251e3c86b68 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -470,19 +470,18 @@ time is up." Try to use an Org header, otherwise use the buffer name." (cond ((derived-mode-p 'org-agenda-mode) - (let* ((marker (or (get-text-property (point) 'org-marker) - (org-agenda-error))) + (let* ((marker (or (get-text-property (point) 'org-marker))) (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))))))) + (when (and marker (marker-buffer 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)))) + (ignore-errors (org-get-heading))) (t (buffer-name (buffer-base-buffer))))) (provide 'org-timer) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 2a783871405..a5219a0e11b 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.3")) + (let ((org-release "9.4.1")) 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.3")) + (let ((org-git-version "release_9.4.1-116-g353bb4")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index a7502d188e2..3db07cd89b3 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4,10 +4,12 @@ ;; Copyright (C) 2004-2020 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik +;; Maintainer: Bastien Guerry ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: https://orgmode.org -;; Version: 9.3 -;; + +;; Version: 9.4.1 + ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -121,9 +123,12 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-archive-subtree-default "org-archive" ()) (declare-function org-archive-to-archive-sibling "org-archive" ()) (declare-function org-attach "org-attach" ()) +(declare-function org-attach-dir "org-attach" + (&optional create-if-not-exists-p no-fs-check)) (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-auto-clockout "org-clock" ()) (declare-function org-clock-cancel "org-clock" ()) (declare-function org-clock-display "org-clock" (&optional arg)) (declare-function org-clock-get-last-clock-out-time "org-clock" ()) @@ -141,6 +146,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (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-columns-quit "org-colview" ()) (declare-function org-columns-insert-dblock "org-colview" ()) (declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt canonical)) (declare-function org-element-at-point "org-element" ()) @@ -172,6 +178,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) (declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) +(declare-function org-num-mode "org-num" (&optional arg)) (declare-function org-plot/gnuplot "org-plot" (&optional params)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function org-timer "org-timer" (&optional restart no-insert)) @@ -189,6 +196,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (defvar org-radio-target-regexp) (defvar org-target-link-regexp) (defvar org-target-regexp) +(defvar org-id-overriding-file-name) ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -215,15 +223,17 @@ and then loads the resulting file using `load-file'. With optional prefix argument COMPILE, the tangled Emacs Lisp file is byte-compiled before it is loaded." (interactive "fFile to load: \nP") - (let* ((tangled-file (concat (file-name-sans-extension file) ".el"))) + (let ((tangled-file (concat (file-name-sans-extension file) ".el"))) ;; Tangle only if the Org file is newer than the Elisp file. (unless (org-file-newer-than-p tangled-file - (file-attribute-modification-time (file-attributes file))) - (org-babel-tangle-file file tangled-file "emacs-lisp")) + (file-attribute-modification-time + (file-attributes (file-truename file)))) + (org-babel-tangle-file file tangled-file "emacs-lisp\\|elisp")) (if compile (progn - (byte-compile-file tangled-file 'load) + (byte-compile-file tangled-file) + (load tangled-file) (message "Compiled and loaded %s" tangled-file)) (load-file tangled-file) (message "Loaded %s" tangled-file)))) @@ -348,6 +358,14 @@ FULL is given." ;;; Syntax Constants +;;;; Comments +(defconst org-comment-regexp + (rx (seq bol (zero-or-more (any "\t ")) "#" (or " " eol))) + "Regular expression for comment lines.") + +;;;; Keyword +(defconst org-keyword-regexp "^[ \t]*#\\+\\(\\S-+?\\):[ \t]*\\(.*\\)$" + "Regular expression for keyword-lines.") ;;;; Block @@ -362,6 +380,65 @@ FULL is given." (defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" "Matches the end of a dynamic block.") +;;;; Timestamp + +(defconst org-ts--internal-regexp + (rx (seq + (= 4 digit) "-" (= 2 digit) "-" (= 2 digit) + (optional " " (*? nonl)))) + "Regular expression matching the innards of a time stamp.") + +(defconst org-ts-regexp (format "<\\(%s\\)>" org-ts--internal-regexp) + "Regular expression for fast time stamp matching.") + +(defconst org-ts-regexp-inactive + (format "\\[\\(%s\\)\\]" org-ts--internal-regexp) + "Regular expression for fast inactive time stamp matching.") + +(defconst org-ts-regexp-both (format "[[<]\\(%s\\)[]>]" org-ts--internal-regexp) + "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.") + ;;;; Clock and Planning (defconst org-clock-string "CLOCK:" @@ -413,7 +490,7 @@ Matched keyword is in group 1.") (defconst org-deadline-time-hour-regexp (concat "\\<" org-deadline-string - " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy \t.-]*\\)>") + " *<\\([^>]+[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 @@ -429,7 +506,7 @@ Matched keyword is in group 1.") (defconst org-scheduled-time-hour-regexp (concat "\\<" org-scheduled-string - " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy \t.-]*\\)>") + " *<\\([^>]+[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 @@ -453,18 +530,6 @@ Matched keyword is in group 1.") " *[[<]\\([^]>]+\\)[]>]") "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 @@ -489,6 +554,12 @@ Group 1 contains drawer's name or \"END\".") (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" "Regular expression matching the last line of a clock drawer.") +(defconst org-logbook-drawer-re + (rx (seq bol (0+ (any "\t ")) ":LOGBOOK:" (0+ (any "\t ")) "\n" + (*? (0+ nonl) "\n") + (0+ (any "\t ")) ":END:" (0+ (any "\t ")) eol)) + "Matches an entire LOGBOOK drawer.") + (defconst org-property-drawer-re (concat "^[ \t]*:PROPERTIES:[ \t]*\n" "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?" @@ -560,60 +631,8 @@ An entry can be toggled between COMMENT and normal with (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.") - -;;;; 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.") +Effort estimates given in this property need to be in the format +defined in org-duration.el.") ;;; The custom variables @@ -644,6 +663,7 @@ After a match, group 1 contains the repeat expression.") (defvar org-modules-loaded nil "Have the modules been loaded already?") +;;;###autoload (defun org-load-modules-maybe (&optional force) "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) @@ -852,6 +872,7 @@ cursor keys will then execute Org commands in the following contexts: - in a plain list item, changing the bullet type - in a property definition line, switching between allowed values - in the BEGIN line of a clock table (changing the time block). +- in a table, moving the cell in the specified direction. Outside these contexts, the commands will throw an error. When this variable is t and the cursor is not in a special @@ -861,9 +882,9 @@ cycling will no longer happen anywhere in an item line, but only 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: +will not be special in headlines, property lines, item lines, and +table cells, to make shift selection work there as well. If this is +what you 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]' \ @@ -879,7 +900,7 @@ will still edit the time stamp - this is just too good to give up." (const :tag "When outside special context" t) (const :tag "Everywhere except timestamps" always))) -(defcustom org-loop-over-headlines-in-active-region nil +(defcustom org-loop-over-headlines-in-active-region t "Shall some commands act upon headlines in the active region? When set to t, some commands will be performed in all headlines @@ -897,16 +918,19 @@ The list of commands is: `org-schedule', `org-deadline', `org-todo', `org-set-tags-command', `org-archive-subtree', `org-archive-set-tag', `org-toggle-archive-tag' and `org-archive-to-archive-sibling'. The archiving commands skip -already archived entries." +already archived entries. + +See `org-agenda-loop-over-headlines-in-active-region' for the +equivalent option for agenda views." :type '(choice (const :tag "Don't loop" nil) (const :tag "All headlines in active region" t) (const :tag "In active region, headlines at the same level than the first one" start-level) (string :tag "Tags/Property/Todo matcher")) - :version "24.1" + :package-version '(Org . "9.4") :group 'org-todo :group 'org-archive) -(defcustom org-startup-folded t +(defcustom org-startup-folded 'showeverything "Non-nil means entering Org mode will switch to OVERVIEW. This can also be configured on a per-file basis by adding one of @@ -921,6 +945,7 @@ 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 + :package-version '(Org . "9.4") :type '(choice (const :tag "nofold: show all" nil) (const :tag "fold: overview" t) @@ -937,7 +962,7 @@ 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 +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 @@ -955,13 +980,24 @@ the following lines anywhere in the buffer: (const :tag "Not" nil) (const :tag "Globally (slow on startup in large files)" t))) +(defcustom org-startup-numerated nil + "Non-nil means turn on `org-num-mode' on startup. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: num + #+STARTUP: nonum" + :group 'org-structure + :package-version '(Org . "9.4") + :type '(choice + (const :tag "Not" nil) + (const :tag "Globally" t))) + (defcustom org-use-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for display. If you want to control how Org exports those characters, see -`org-export-with-sub-superscripts'. `org-use-sub-superscripts' -used to be an alias for `org-export-with-sub-superscripts' in -Org <8.0, it is not anymore. +`org-export-with-sub-superscripts'. When this option is turned on, you can use TeX-like syntax for sub- and superscripts within the buffer. Several characters after @@ -1058,15 +1094,51 @@ 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 -effective." +effective. It cannot be set as a local variable." :group 'org-startup :type '(choice (const :tag "Default" nil) - (string :tag "String" :value "...#")) - :safe (lambda (v) (and (string-or-null-p v) (not (equal "" v))))) + (string :tag "String" :value "...#"))) (defvar org-display-table nil "The display table for Org mode, in case `org-ellipsis' is non-nil.") +(defcustom org-directory "~/org" + "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 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 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) + +(defcustom org-default-notes-file (convert-standard-filename "~/.notes") + "Default target for storing notes. +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 'file) + +(defcustom org-reverse-note-order nil + "Non-nil means store new notes at the beginning of a file or entry. +When nil, new notes will be filed to the end of a file or entry. +This can also be a list with cons cells of regular expressions that +are matched against file names, and values." + :group 'org-capture + :group 'org-refile + :type '(choice + (const :tag "Reverse always" t) + (const :tag "Reverse never" nil) + (repeat :tag "By file name regexp" + (cons regexp boolean)))) + (defgroup org-keywords nil "Keywords in Org mode." :tag "Org Keywords" @@ -1097,7 +1169,7 @@ effective." "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 +locations. As a consequence, Org always exposes a neighborhood around point. How much is shown depends on the initial action, or context. Valid contexts are @@ -1219,16 +1291,17 @@ See `org-file-apps'.") (defcustom org-file-apps '((auto-mode . emacs) + (directory . emacs) ("\\.mm\\'" . default) ("\\.x?html?\\'" . default) ("\\.pdf\\'" . default)) - "External applications for opening `file:path' items in a document. + "Applications for opening `file:path' items in a document. \\ -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. +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: @@ -1304,6 +1377,7 @@ For more examples, see the system specific constants `org-file-apps-windowsnt' `org-file-apps-gnu'." :group 'org + :package-version '(Org . "9.4") :type '(repeat (cons (choice :value "" (string :tag "Extension") @@ -1466,6 +1540,7 @@ the values `folded', `children', or `subtree'." :type 'hook) (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-cycle-hide-drawers org-cycle-show-empty-lines org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. @@ -1475,9 +1550,8 @@ 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 - :version "26.1" - :package-version '(Org . "8.3")) + :package-version '(Org . "9.4") + :type 'hook) (defgroup org-edit-structure nil "Options concerning structure editing in Org mode." @@ -1503,9 +1577,15 @@ lines to the buffer: (defcustom org-adapt-indentation t "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: +When this variable is set to t, Org assumes that you write +outlines by indenting text in each node to align with the +headline (after the stars). + +When this variable is set to 'headline-data, only adapt the +indentation of the data lines right below the headline, such as +planning/clock lines and property/logbook drawers. + +The following issues are influenced by this variable: - The indentation is increased by one space in a demotion command, and decreased by one in a promotion command. However, @@ -1517,14 +1597,18 @@ stars). The following issues are influenced by this variable: when this variable is set. When nil, they will not be indented. - TAB indents a line relative to current level. The lines below - a headline will be indented when this variable is set. + a headline will be indented when this variable is set to t. 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 + :type '(choice + (const :tag "Adapt indentation for all lines" t) + (const :tag "Adapt indentation for headline data lines" + 'headline-data) + (const :tag "Do not adapt indentation at all" nil)) :safe #'booleanp) (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) @@ -1572,16 +1656,15 @@ This may also be a cons cell where the behavior for `C-a' and When nil, `C-k' will call the default `kill-line' command. When t, the following will happen while the cursor is in the headline: -- When the cursor is at the beginning of a headline, kill the entire - line and possible the folded subtree below the line. -- When in the middle of the headline text, kill the headline up to the tags. -- When after the headline text, kill the tags." +- When at the beginning of a headline, kill the entire subtree. +- When in the middle of the headline text, kill the text up to the tags. +- When after the headline text and before the tags, kill all the tags." :group 'org-edit-structure :type 'boolean) (defcustom org-ctrl-k-protect-subtree nil - "Non-nil means, do not delete a hidden subtree with C-k. -When set to the symbol `error', simply throw an error when C-k is + "Non-nil means, do not delete a hidden subtree with `C-k'. +When set to the symbol `error', simply throw an error when `C-k' is used to kill (part-of) a headline that has hidden text behind it. Any other non-nil value will result in a query to the user, if it is OK to kill that hidden subtree. When nil, kill without remorse." @@ -1786,213 +1869,6 @@ Changing this requires a restart of Emacs to work correctly." :group 'org-link-follow :type 'integer) -(defgroup org-refile nil - "Options concerning refiling entries in Org mode." - :tag "Org Refile" - :group 'org) - -(defcustom org-directory "~/org" - "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 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 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) - -(defcustom org-default-notes-file (convert-standard-filename "~/.notes") - "Default target for storing notes. -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 'file) - -(defcustom org-reverse-note-order nil - "Non-nil means store new notes at the beginning of a file or entry. -When nil, new notes will be filed to the end of a file or entry. -This can also be a list with cons cells of regular expressions that -are matched against file names, and values." - :group 'org-capture - :group 'org-refile - :type '(choice - (const :tag "Reverse always" t) - (const :tag "Reverse never" nil) - (repeat :tag "By file name regexp" - (cons regexp boolean)))) - -(defcustom org-log-refile nil - "Information to record when a task is refiled. - -Possible values are: - -nil Don't add anything -time Add a time stamp to the task -note Prompt for a note and add it with template `org-log-note-headings' - -This option can also be set with on a per-file-basis with - - #+STARTUP: nologrefile - #+STARTUP: logrefile - #+STARTUP: lognoterefile - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords. - -When bulk-refiling, e.g., from the agenda, the value `note' is -forbidden and will temporarily be changed to `time'." - :group 'org-refile - :group 'org-progress - :version "24.1" - :type '(choice - (const :tag "No logging" nil) - (const :tag "Record timestamp" time) - (const :tag "Record timestamp with note." note))) - -(defcustom org-refile-targets nil - "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 - a file name or a list of file names. If you use `org-agenda-files' for - that, all agenda files will be scanned for targets. Nil means consider - headings in the current buffer. -- A specification of how to find candidate refile targets. This may be - any of: - - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. - This tag has to be present in all target headlines, inheritance will - not be considered. - - a cons cell (:todo . \"KEYWORD\") to identify refile targets by - todo keyword. - - a cons cell (:regexp . \"REGEXP\") with a regular expression matching - headlines that are refiling targets. - - a cons cell (:level . N). Any headline of level N is considered a target. - Note that, when `org-odd-levels-only' is set, level corresponds to - order in hierarchy, not to the number of stars. - - a cons cell (:maxlevel . N). Any headline with level <= N is a target. - Note that, when `org-odd-levels-only' is set, level corresponds to - order in hierarchy, not to the number of stars. - -Each element of this list generates a set of possible targets. -The union of these sets is presented (with completion) to -the user by `org-refile'. - -You can set the variable `org-refile-target-verify-function' to a function -to verify each headline found by the simple criteria above. - -When this variable is nil, all top-level headlines in the current buffer -are used, equivalent to the value `((nil . (:level . 1))'." - :group 'org-refile - :type '(repeat - (cons - (choice :value org-agenda-files - (const :tag "All agenda files" org-agenda-files) - (const :tag "Current buffer" nil) - (function) (variable) (file)) - (choice :tag "Identify target headline by" - (cons :tag "Specific tag" (const :value :tag) (string)) - (cons :tag "TODO keyword" (const :value :todo) (string)) - (cons :tag "Regular expression" (const :value :regexp) (regexp)) - (cons :tag "Level number" (const :value :level) (integer)) - (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) - -(defcustom org-refile-target-verify-function nil - "Function to verify if the headline at point should be a refile target. -The function will be called without arguments, with point at the -beginning of the headline. It should return t and leave point -where it is if the headline is a valid target for refiling. - -If the target should not be selected, the function must return nil. -In addition to this, it may move point to a place from where the search -should be continued. For example, the function may decide that the entire -subtree of the current entry should be excluded and move point to the end -of the subtree." - :group 'org-refile - :type '(choice - (const nil) - (function))) - -(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 \\[org-refile]' or, -if you find that easier, \ -`\\[universal-argument] \\[universal-argument] \\[universal-argument] \ -\\[org-refile]'." - :group 'org-refile - :version "24.1" - :type 'boolean) - -(defcustom org-refile-use-outline-path nil - "Non-nil means provide refile targets as paths. -So a level 3 headline will be available as level1/level2/level3. - -When the value is `file', also include the file name (without directory) -into the path. In this case, you can also stop the completion after -the file name, to get entries inserted as top level in the file. - -When `full-file-path', include the full file path. - -When `buffer-name', use the buffer name." - :group 'org-refile - :type '(choice - (const :tag "Not" nil) - (const :tag "Yes" t) - (const :tag "Start with file name" file) - (const :tag "Start with full file path" full-file-path) - (const :tag "Start with buffer name" buffer-name))) - -(defcustom org-outline-path-complete-in-steps t - "Non-nil means complete the outline path in hierarchical steps. -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) - -(defcustom org-refile-allow-creating-parent-nodes nil - "Non-nil means allow the creation of new nodes as refile targets. -New nodes are then created by adding \"/new node name\" to the completion -of an existing node. When the value of this variable is `confirm', -new node creation must be confirmed by the user (recommended). -When nil, the completion must match an existing entry. - -Note that, if the new heading is not seen by the criteria -listed in `org-refile-targets', multiple instances of the same -heading would be created by trying again to file under the new -heading." - :group 'org-refile - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Prompt for confirmation" confirm))) - -(defcustom org-refile-active-region-within-subtree nil - "Non-nil means also refile active region within a subtree. - -By default `org-refile' doesn't allow refiling regions if they -don't contain a set of subtrees, but it might be convenient to -do so sometimes: in that case, the first line of the region is -converted to a headline before refiling." - :group 'org-refile - :version "24.1" - :type 'boolean) - (defgroup org-todo nil "Options concerning TODO items in Org mode." :tag "Org TODO" @@ -2548,53 +2424,69 @@ property to one or more of these keywords." :tag "Org Priorities" :group 'org-todo) -(defcustom org-enable-priority-commands t +(defvaralias 'org-enable-priority-commands 'org-priority-enable-commands) +(defcustom org-priority-enable-commands t "Non-nil means priority commands are active. When nil, these commands will be disabled, so that you never accidentally set a priority." :group 'org-priorities :type 'boolean) -(defcustom org-highest-priority ?A - "The highest priority of TODO items. A character like ?A, ?B etc. -Must have a smaller ASCII number than `org-lowest-priority'." - :group 'org-priorities - :type 'character) +(defvaralias 'org-highest-priority 'org-priority-highest) -(defcustom org-lowest-priority ?C - "The lowest priority of TODO items. A character like ?A, ?B etc. -Must have a larger ASCII number than `org-highest-priority'." +(defcustom org-priority-highest ?A + "The highest priority of TODO items. +A character like ?A, ?B, etc., or a numeric value like 1, 2, etc. +Must be smaller than `org-priority-lowest'." :group 'org-priorities - :type 'character) + :type '(choice + (character :tag "Character") + (integer :tag "Integer (< 65)"))) -(defcustom org-default-priority ?B +(defvaralias 'org-lowest-priority 'org-priority-lowest) +(defcustom org-priority-lowest ?C + "The lowest priority of TODO items. +A character like ?A, ?B, etc., or a numeric value like 1, 2, etc. +Must be higher than `org-priority-highest'." + :group 'org-priorities + :type '(choice + (character :tag "Character") + (integer :tag "Integer (< 65)"))) + +(defvaralias 'org-default-priority 'org-priority-default) +(defcustom org-priority-default ?B "The default priority of TODO items. This is the priority an item gets if no explicit priority is given. When starting to cycle on an empty priority the first step in the cycle depends on `org-priority-start-cycle-with-default'. The resulting first -step priority must not exceed the range from `org-highest-priority' to -`org-lowest-priority' which means that `org-default-priority' has to be -in this range exclusive or inclusive the range boundaries. Else the -first step refuses to set the default and the second will fall back -to (depending on the command used) the highest or lowest priority." +step priority must not exceed the range from `org-priority-highest' to +`org-priority-lowest' which means that `org-priority-default' has to be +in this range exclusive or inclusive to the range boundaries. Else the +first step refuses to set the default and the second will fall back on +\(depending on the command used) the highest or lowest priority." :group 'org-priorities - :type 'character) + :type '(choice + (character :tag "Character") + (integer :tag "Integer (< 65)"))) (defcustom org-priority-start-cycle-with-default t "Non-nil means start with default priority when starting to cycle. When this is nil, the first step in the cycle will be (depending on the command used) one higher or lower than the default priority. -See also `org-default-priority'." +See also `org-priority-default'." :group 'org-priorities :type 'boolean) -(defcustom org-get-priority-function nil +(defvaralias 'org-get-priority-function 'org-priority-get-priority-function) +(defcustom org-priority-get-priority-function nil "Function to extract the priority from a string. -The string is normally the headline. If this is nil Org computes the -priority from the priority cookie like [#A] in the headline. It returns -an integer, increasing by 1000 for each priority level. -The user can set a different function here, which should take a string -as an argument and return the numeric priority." +The string is normally the headline. If this is nil, Org +computes the priority from the priority cookie like [#A] in the +headline. It returns an integer, increasing by 1000 for each +priority level. + +The user can set a different function here, which should take a +string as an argument and return the numeric priority." :group 'org-priorities :version "24.1" :type '(choice @@ -2767,7 +2659,9 @@ stamps outside of this range." (defcustom org-read-date-display-live t "Non-nil means display current interpretation of date prompt live. -This display will be in an overlay, in the minibuffer." +This display will be in an overlay, in the minibuffer. Note that +live display is only active when `org-read-date-popup-calendar' +is non-nil." :group 'org-time :type 'boolean) @@ -2944,7 +2838,7 @@ automatically if necessary." When nil, you have to press RET to exit it. During fast tag selection, you can toggle this flag with `C-c'. This variable can also have the value `expert'. In this case, the window -displaying the tags menu is not even shown, until you press C-c again." +displaying the tags menu is not even shown, until you press `C-c' again." :group 'org-tags :type '(choice (const :tag "No" nil) @@ -3180,8 +3074,13 @@ This list will be combined with the constant `org-global-properties-fixed'. The entries in this list are cons cells where the car is a property name and cdr is a string with the value. -You can set buffer-local values for the same purpose in the variable -`org-file-properties' this by adding lines like +Buffer local properties are added either by a document property drawer + +:PROPERTIES: +:NAME: VALUE +:END: + +or by adding lines like #+PROPERTY: NAME VALUE" :group 'org-properties @@ -3189,10 +3088,15 @@ You can set buffer-local values for the same purpose in the variable (cons (string :tag "Property") (string :tag "Value")))) -(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.") +(defvar-local org-keyword-properties nil + "List of property/value pairs inherited by any entry. + +Valid for the current buffer. This variable is populated from +PROPERTY keywords. + +Note that properties are defined also in property drawers. +Properties defined there take precedence over properties defined +as keywords.") (defgroup org-agenda nil "Options concerning agenda views in Org mode." @@ -3201,11 +3105,18 @@ This variable is populated from #+PROPERTY lines.") (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 +There are multiple ways to set the category. One way is to set +it in the document property drawer. For example: + +:PROPERTIES: +:CATEGORY: ELisp +:END: + +Other ways to define it is as an emacs file variable, for example # -*- mode: org; org-category: \"ELisp\" -or contain a special line +or for the file to contain a special line: #+CATEGORY: ELisp @@ -3266,16 +3177,6 @@ A nil value means to remove them, after a query, from the list." :group 'org-agenda :type 'boolean) -(defcustom org-agenda-diary-file 'diary-file - "File to which to add new entries with the `i' key in agenda and calendar. -When this is the symbol `diary-file', the functionality in the Emacs -calendar will be used to add entries to the `diary-file'. But when this -points to a file, `org-agenda-diary-entry' will be used instead." - :group 'org-agenda - :type '(choice - (const :tag "The standard Emacs diary file" diary-file) - (file :tag "Special Org file diary entries"))) - (defgroup org-latex nil "Options for embedding LaTeX code into Org mode." :tag "Org LaTeX" @@ -3349,6 +3250,22 @@ When using LaTeXML set this option to (const :tag "None" nil) (string :tag "\nShell command"))) +(defcustom org-latex-to-html-convert-command nil + "Command to convert LaTeX fragments to HTML. +This command is very open-ended: the output of the command will +directly replace the LaTeX fragment in the resulting HTML. +Replace format-specifiers in the command as noted below and use +`shell-command' to convert LaTeX to HTML. +%i: The LaTeX fragment to be converted. + +For example, this could be used with LaTeXML as +\"latexmlc 'literal:%i' --profile=math --preload=siunitx.sty 2>/dev/null\"." + :group 'org-latex + :package-version '(Org . "9.4") + :type '(choice + (const :tag "None" nil) + (string :tag "Shell command"))) + (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 @@ -3667,12 +3584,23 @@ hide them with `org-toggle-custom-properties-visibility'." :version "24.3" :type '(repeat (string :tag "Property Name"))) -(defcustom org-fontify-done-headline nil +(defcustom org-fontify-todo-headline nil + "Non-nil means change the face of a headline if it is marked as TODO. +Normally, only the TODO/DONE keyword indicates the state of a headline. +When this is non-nil, the headline after the keyword is set to the +`org-headline-todo' as an additional indication." + :group 'org-appearance + :package-version '(Org . "9.4") + :type 'boolean + :safe t) + +(defcustom org-fontify-done-headline t "Non-nil means change the face of a headline if it is marked DONE. Normally, only the TODO/DONE keyword indicates the state of a headline. When this is non-nil, the headline after the keyword is set to the `org-headline-done' as an additional indication." :group 'org-appearance + :package-version '(Org . "9.4") :type 'boolean) (defcustom org-fontify-emphasized-text t @@ -3774,7 +3702,7 @@ After a match, the match groups contain these elements: ;; This used to be a defcustom (Org <8.0) but allowing the users to ;; set this option proved cumbersome. See this message/thread: -;; http://article.gmane.org/gmane.emacs.orgmode/68681 +;; https://orgmode.org/list/B72CDC2B-72F6-43A8-AC70-E6E6295766EC@gmail.com (defvar org-emphasis-regexp-components '("-[:space:]('\"{" "-[:space:].,:!?;'\")}\\[" "[:space:]" "." 1) "Components used to build the regular expression for emphasis. @@ -3920,6 +3848,14 @@ If yes, offer to stop it and to save the buffer with the changes." (add-hook 'org-mode-hook 'org-clock-load) (add-hook 'kill-emacs-hook 'org-clock-save)) +(defun org-clock-auto-clockout-insinuate () + "Set up hook for auto clocking out when Emacs is idle. +See `org-clock-auto-clockout-timer'. + +This function is meant to be added to the user configuration." + (require 'org-clock) + (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t)) + (defgroup org-archive nil "Options concerning archiving in Org mode." :tag "Org Archive" @@ -3973,14 +3909,13 @@ Here are a few examples: Archive in file ./basement (relative path), as level 3 trees below the level 2 heading \"** Finished Tasks\". -You may set this option on a per-file basis by adding to the buffer a -line like +You may define it locally by setting an ARCHIVE property. If +such a property is found in the file or in an entry, and anywhere +up the hierarchy, it will be used. -#+ARCHIVE: basement::** Finished Tasks +You can also set it for the whole file using the keyword-syntax: -You may also define it locally for a subtree by setting an ARCHIVE property -in the entry. If such a property is found in an entry, or anywhere up -the hierarchy, it will be used." +#+ARCHIVE: basement::** Finished Tasks" :group 'org-archive :type 'string) @@ -4189,6 +4124,8 @@ After a match, the following groups carry important information: ("content" org-startup-folded content) ("indent" org-startup-indented t) ("noindent" org-startup-indented nil) + ("num" org-startup-numerated t) + ("nonum" org-startup-numerated nil) ("hidestars" org-hide-leading-stars t) ("showstars" org-hide-leading-stars nil) ("odd" org-odd-levels-only t) @@ -4302,72 +4239,112 @@ See `org-tag-alist' for their structure." ;; Preserve order of ALIST1. (append (nreverse to-add) alist2))))) +(defun org-priority-to-value (s) + "Convert priority string S to its numeric value." + (or (save-match-data + (and (string-match "\\([0-9]+\\)" s) + (string-to-number (match-string 1 s)))) + (string-to-char s))) + (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) - (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"))))))) + (let ((alist (org-collect-keywords + (append '("FILETAGS" "TAGS") + (and (not tags-only) + '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS" + "LINK" "OPTIONS" "PRIORITIES" "PROPERTY" + "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO"))) + '("ARCHIVE" "CATEGORY" "COLUMNS" "PRIORITIES")))) ;; Startup options. Get this early since it does change ;; behavior for other options (e.g., tags). - (let ((startup (cdr (assq 'startup alist)))) + (let ((startup (cl-mapcan (lambda (value) (split-string value)) + (cdr (assoc "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))))))) + (pcase (assoc-string option org-startup-options t) + (`(,_ ,variable ,value t) + (unless (listp (symbol-value variable)) + (set (make-local-variable variable) nil)) + (add-to-list variable value)) + (`(,_ ,variable ,value . ,_) + (set (make-local-variable variable) value)) + (_ nil)))) (setq-local org-file-tags (mapcar #'org-add-prop-inherited - (cdr (assq 'filetags alist)))) + (cl-mapcan (lambda (value) + (cl-mapcan + (lambda (k) (org-split-string k ":")) + (split-string value))) + (cdr (assoc "FILETAGS" alist))))) (setq org-current-tag-alist (org--tag-add-to-alist org-tag-persistent-alist - (let ((tags (cdr (assq 'tags alist)))) - (if tags (org-tag-string-to-alist tags) + (let ((tags (cdr (assoc "TAGS" alist)))) + (if tags + (org-tag-string-to-alist + (mapconcat #'identity tags "\n")) 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))) + ;; Properties. + (let ((properties nil)) + (dolist (value (cdr (assoc "PROPERTY" alist))) + (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value) + (setq properties (org--update-property-plist + (match-string-no-properties 1 value) + (match-string-no-properties 2 value) + properties)))) + (setq-local org-keyword-properties properties)) ;; Archive location. - (let ((archive (cdr (assq 'archive alist)))) + (let ((archive (cdr (assoc "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 + (let ((category (cdr (assoc "CATEGORY" alist)))) + (when category + (setq-local org-category (intern category)) + (setq-local org-keyword-properties (org--update-property-plist - "CATEGORY" cat org-file-properties)))) + "CATEGORY" category org-keyword-properties)))) ;; Columns. - (let ((column (cdr (assq 'columns alist)))) + (let ((column (cdr (assoc "COLUMNS" alist)))) (when column (setq-local org-columns-default-format column))) ;; Constants. - (setq org-table-formula-constants-local (cdr (assq 'constants alist))) + (let ((store nil)) + (dolist (pair (cl-mapcan #'split-string + (cdr (assoc "CONSTANTS" alist)))) + (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))))) + (setq org-table-formula-constants-local store)) ;; Link abbreviations. - (let ((links (cdr (assq 'link alist)))) + (let ((links + (delq nil + (mapcar + (lambda (value) + (and (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value) + (cons (match-string-no-properties 1 value) + (match-string-no-properties 2 value)))) + (cdr (assoc "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)))) + (let ((value (cdr (assoc "PRIORITIES" alist)))) + (pcase (and value (split-string value)) + (`(,high ,low ,default . ,_) + (setq-local org-priority-highest (org-priority-to-value high)) + (setq-local org-priority-lowest (org-priority-to-value low)) + (setq-local org-priority-default (org-priority-to-value default))))) ;; Scripts. - (let ((scripts (assq 'scripts alist))) - (when scripts - (setq-local org-use-sub-superscripts (cdr scripts)))) + (let ((value (cdr (assoc "OPTIONS" alist)))) + (dolist (option value) + (when (string-match "\\^:\\(t\\|nil\\|{}\\)" option) + (setq-local org-use-sub-superscripts + (read (match-string 1 option)))))) ;; TODO keywords. (setq-local org-todo-kwd-alist nil) (setq-local org-todo-key-alist nil) @@ -4378,7 +4355,13 @@ related expressions." (setq-local org-todo-sets nil) (setq-local org-todo-log-states nil) (let ((todo-sequences - (or (nreverse (cdr (assq 'todo alist))) + (or (append (mapcar (lambda (value) + (cons 'type (split-string value))) + (cdr (assoc "TYP_TODO" alist))) + (mapcar (lambda (value) + (cons 'sequence (split-string value))) + (append (cdr (assoc "TODO" alist)) + (cdr (assoc "SEQ_TODO" alist))))) (let ((d (default-value 'org-todo-keywords))) (if (not (stringp (car d))) d ;; XXX: Backward compatibility code. @@ -4463,109 +4446,90 @@ related expressions." "[ \t]*$")) (org-compute-latex-and-related-regexp))))) -(defun org--setup-collect-keywords (regexp &optional files alist) - "Return setup keywords values as an alist. +(defun org-collect-keywords (keywords &optional unique directory) + "Return values for KEYWORDS in current buffer, 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. +KEYWORDS is a list of strings. Return value is a list of +elements with the pattern: -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 (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 ":")) - (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 (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) (split-string value))) - (push (cons 'startup (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) - (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-strip-quotes 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. + (NAME . LIST-OF-VALUES) + +where NAME is the upcase name of the keyword, and LIST-OF-VALUES +is a list of non-empty values, as strings, in order of appearance +in the buffer. + +When KEYWORD appears in UNIQUE list, LIST-OF-VALUE is its first +value, empty or not, appearing in the buffer, as a string. + +When KEYWORD appears in DIRECTORIES, each value is a cons cell: + + (VALUE . DIRECTORY) + +where VALUE is the regular value, and DIRECTORY is the variable +`default-directory' for the buffer containing the keyword. This +is important for values containing relative file names, since the +function follows SETUPFILE keywords, and may change its working +directory." + (let* ((keywords (cons "SETUPFILE" (mapcar #'upcase keywords))) + (unique (mapcar #'upcase unique)) + (alist (org--collect-keywords-1 + keywords unique directory + (and buffer-file-name (list buffer-file-name)) + nil))) + ;; Re-order results. + (dolist (entry alist) + (pcase entry + (`(,_ . ,(and value (pred consp))) + (setcdr entry (nreverse value))))) + (nreverse alist))) + +(defun org--collect-keywords-1 (keywords unique directory files alist) + (org-with-point-at 1 + (let ((case-fold-search t) + (regexp (org-make-options-regexp keywords))) + (while (and keywords (re-search-forward regexp nil t)) + (let ((element (org-element-at-point))) + (when (eq 'keyword (org-element-type element)) + (let ((value (org-element-property :value element))) + (pcase (org-element-property :key element) + ("SETUPFILE" + (when (and (org-string-nw-p value) + (not buffer-read-only)) ;FIXME: bug in Gnus? + (let* ((uri (org-strip-quotes value)) + (uri-is-url (org-file-url-p uri)) + (uri (if uri-is-url + uri + (expand-file-name uri)))) + (unless (member uri files) + (with-temp-buffer + (unless uri-is-url + (setq default-directory (file-name-directory uri))) + (let ((contents (org-file-contents uri :noerror))) + (when contents + (insert contents) + ;; Fake Org mode: `org-element-at-point' + ;; doesn't need full set-up. (let ((major-mode 'org-mode)) - (org--setup-collect-keywords - regexp (cons f files) alist))))))))))))))) - alist) + (setq alist + (org--collect-keywords-1 + keywords unique directory + (cons uri files) + alist)))))))))) + (keyword + (let ((entry (assoc keyword alist)) + (final + (cond ((not (member keyword directory)) value) + (buffer-file-name + (cons value + (file-name-directory buffer-file-name))) + (t (cons value default-directory))))) + (cond ((member keyword unique) + (push (cons keyword final) alist) + (setq keywords (remove keyword keywords)) + (setq regexp (org-make-options-regexp keywords))) + ((null entry) (push (list keyword final) alist)) + (t (push final (cdr entry))))))))))) + alist))) (defun org-tag-string-to-alist (s) "Return tag alist associated to string S. @@ -4677,7 +4641,7 @@ already cached in the `org--file-cache' hash table, the download step is skipped. If NOERROR is non-nil, ignore the error when unable to read the FILE -from file or URL. +from file or URL, and return nil. If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version is available. This option applies only if FILE is a URL." @@ -4701,7 +4665,8 @@ is available. This option applies only if FILE is a URL." org--file-cache) (funcall (if noerror #'message #'user-error) "Unable to fetch file from %S" - file)))) + file) + nil))) (t (with-temp-buffer (condition-case nil @@ -4711,7 +4676,8 @@ is available. This option applies only if FILE is a URL." (file-error (funcall (if noerror #'message #'user-error) "Unable to read file %S" - file)))))))) + file) + nil))))))) (defun org-extract-log-state-settings (x) "Extract the log state setting from a TODO keyword string. @@ -4790,12 +4756,9 @@ This is for getting out of special buffers like capture.") (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 (require 'org-entities) -;; (require 'org-compat) moved higher up in the file before it is first used (require 'org-faces) (require 'org-list) (require 'org-pcomplete) @@ -4829,7 +4792,6 @@ The following commands are available: (org-install-agenda-files-menu) (when org-link-descriptive (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-hide-block . t)) - (add-to-invisibility-spec '(org-hide-drawer . t)) (setq-local outline-regexp org-outline-regexp) (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) @@ -4905,10 +4867,6 @@ The following commands are available: (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") (modes . '(org-mode))))) - ;; Make isearch reveal context - (setq-local outline-isearch-open-invisible-function - (lambda (&rest _) (org-show-context 'isearch))) - ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) (setq-local pcomplete-command-name-function #'org-command-at-point) @@ -4940,11 +4898,20 @@ The following commands are available: (when org-startup-with-latex-preview (org-latex-preview '(16))) (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) (when org-startup-truncated (setq truncate-lines t)) + (when org-startup-numerated (require 'org-num) (org-num-mode 1)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)))) + + ;; Activate `org-table-header-line-mode' + (when org-table-header-line-p + (org-table-header-line-mode 1)) ;; Try to set `org-hide' face correctly. (let ((foreground (org-find-invisible-foreground))) (when foreground - (set-face-foreground 'org-hide foreground)))) + (set-face-foreground 'org-hide foreground))) + ;; Set face extension as requested. + (org--set-faces-extend '(org-block-begin-line org-block-end-line) + org-fontify-whole-block-delimiter-line) + (org--set-faces-extend org-level-faces org-fontify-whole-heading-line)) ;; Update `customize-package-emacs-version-alist' (add-to-list 'customize-package-emacs-version-alist @@ -4955,7 +4922,9 @@ The following commands are available: ("8.3" . "26.1") ("9.0" . "26.1") ("9.1" . "26.1") - ("9.2" . "27.1"))) + ("9.2" . "27.1") + ("9.3" . "27.1") + ("9.4" . "27.2"))) (defvar org-mode-transpose-word-syntax-table (let ((st (make-syntax-table text-mode-syntax-table))) @@ -5004,8 +4973,6 @@ the rounding returns a past time." ;;;; Font-Lock stuff, including the activators -(require 'font-lock) - (defconst org-match-sexp-depth 3 "Number of stacked braces for sub/superscript matching.") @@ -5076,9 +5043,10 @@ stacked delimiters is N. Escaping delimiters is not possible." ;; Do not span over cells in table rows. (not (and (save-match-data (org-match-line "[ \t]*|")) (string-match-p "|" (match-string 4)))))) - (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist))) + (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)) + (m (if org-hide-emphasis-markers 4 2))) (font-lock-prepend-text-property - (match-beginning 2) (match-end 2) 'face face) + (match-beginning m) (match-end m) 'face face) (when verbatim? (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) @@ -5086,7 +5054,8 @@ stacked delimiters is N. Escaping delimiters is not possible." '(display t invisible t intangible t))) (add-text-properties (match-beginning 2) (match-end 2) '(font-lock-multiline t org-emphasis t)) - (when org-hide-emphasis-markers + (when (and org-hide-emphasis-markers + (not (org-at-comment-p))) (add-text-properties (match-end 4) (match-beginning 5) '(invisible org-link)) (add-text-properties (match-beginning 3) (match-end 3) @@ -5249,13 +5218,23 @@ by a #." "Fontify #+ lines and blocks." (let ((case-fold-search t)) (when (re-search-forward - "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" + (rx bol (group (zero-or-more (any " \t")) "#" + (group (group (or (seq "+" (one-or-more (any "a-zA-Z")) (optional ":")) + (any " \t") + eol)) + (optional (group "_" (group (one-or-more (any "a-zA-Z")))))) + (zero-or-more (any " \t")) + (group (group (zero-or-more (not (any " \t\n")))) + (zero-or-more (any " \t")) + (group (zero-or-more any))))) limit t) (let ((beg (match-beginning 0)) (end-of-beginline (match-end 0)) - (block-start (match-end 0)) ; includes the \n at end of #+begin line - (block-end nil) ; will include \n after end of block content - (lang (match-string 7)) ; the language, if it is an src block + ;; Including \n at end of #+begin line will include \n + ;; after the end of block content. + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) ; The language, if it is a source block. (bol-after-beginline (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) @@ -5265,15 +5244,22 @@ by a #." ((and (match-end 4) (equal dc3 "+begin")) ;; Truly a block (setq block-type (downcase (match-string 5)) - quoting (member block-type org-protecting-blocks)) ; src, example, export, maybe more + ;; Src, example, export, maybe more. + 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 - ;; We do have a matching #+end line + (rx-to-string `(group bol (or (seq (one-or-more "*") space) + (seq (zero-or-more (any " \t")) + "#+end" + ,(match-string 4) + word-end + (zero-or-more any))))) + ;; We look further than LIMIT on purpose. + nil t) + ;; We do have a matching #+end line. (setq beg-of-endline (match-beginning 0) end-of-endline (match-end 0) nl-before-endline (1- (match-beginning 0))) - (setq block-end (match-beginning 0)) ; includes the final newline. + (setq block-end (match-beginning 0)) ; Include the final newline. (when quoting (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline) (remove-text-properties beg end-of-endline @@ -5306,10 +5292,14 @@ by a #." (add-text-properties beg (if whole-blockline bol-after-beginline end-of-beginline) '(face org-block-begin-line)) - (add-text-properties - beg-of-endline - (min (point-max) (if whole-blockline (min (point-max) (1+ end-of-endline)) end-of-endline)) - '(face org-block-end-line)) + (unless (eq (char-after beg-of-endline) ?*) + (add-text-properties + beg-of-endline + (if whole-blockline + (let ((beg-of-next-line (1+ end-of-endline))) + (min (point-max) beg-of-next-line)) + (min (point-max) end-of-endline)) + '(face org-block-end-line))) t)) ((member dc1 '("+title:" "+author:" "+email:" "+date:")) (org-remove-flyspell-overlays-in @@ -5329,22 +5319,26 @@ by a #." (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. + ;; Handle short captions (save-excursion (beginning-of-line) - (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*")) + (looking-at (rx (group (zero-or-more (any " \t")) + "#+caption" + (optional "[" (zero-or-more any) "]") + ":") + (zero-or-more (any " \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 '(" " "")) - ; Just a comment, the plus was not there + ;; Just a comment, the plus was not there (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 + (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)) @@ -5355,9 +5349,8 @@ by a #." (defun org-fontify-drawers (limit) "Fontify drawers." (when (re-search-forward org-drawer-regexp limit t) - (add-text-properties - (line-beginning-position) (line-beginning-position 2) - '(font-lock-fontified t face org-drawer)) + (add-text-properties (1- (match-beginning 1)) (1+ (match-end 1)) + '(font-lock-fontified t face org-drawer)) (org-remove-flyspell-overlays-in (line-beginning-position) (line-beginning-position 2)) t)) @@ -5385,8 +5378,8 @@ by a #." (end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)") (extend (lambda (r1 r2 dir) (let ((re (replace-regexp-in-string "\\(begin\\|end\\)" r1 - (replace-regexp-in-string "[][]" r2 - (match-string-no-properties 0))))) + (replace-regexp-in-string "[][]" r2 + (match-string-no-properties 0))))) (re-search-forward (regexp-quote re) nil t dir))))) (save-match-data (save-excursion @@ -5482,33 +5475,46 @@ Result depends on variable `org-highlight-latex-and-related'." (append re-latex re-entities re-sub) "\\|")))) -(defun org-do-latex-and-related (_limit) +(defun org-do-latex-and-related (limit) "Highlight LaTeX snippets and environments, entities and sub/superscript. Stop at first highlighted object, if any. Return t if some highlighting was done, nil otherwise." (when (org-string-nw-p org-latex-and-related-regexp) - (catch 'found - (while (re-search-forward org-latex-and-related-regexp - nil t) ;; on purpose, we ignore LIMIT - (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 - 0)) - (start (+ offset (match-beginning 0))) - (end (match-end 0))) - (if (memq 'native org-highlight-latex-and-related) - (org-src-font-lock-fontify-block "latex" start end) - (font-lock-prepend-text-property start end - 'face 'org-latex-and-related)) - (add-text-properties (+ offset (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))) - (throw 'found t))) - nil))) + (let ((latex-prefix-re (rx (or "$" "\\(" "\\["))) + (blank-line-re (rx (and "\n" (zero-or-more (or " " "\t")) "\n")))) + (catch 'found + (while (and (< (point) limit) + (re-search-forward org-latex-and-related-regexp nil t)) + (cond + ((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)))) + ;; Try to limit false positives. In this case, ignore + ;; $$...$$, \(...\), and \[...\] LaTeX constructs if they + ;; contain an empty line. + ((save-excursion + (goto-char (match-beginning 0)) + (and (looking-at-p latex-prefix-re) + (save-match-data + (re-search-forward blank-line-re (1- (match-end 0)) t))))) + (t + (let* ((offset (if (memq (char-after (1+ (match-beginning 0))) + '(?_ ?^)) + 1 + 0)) + (start (+ offset (match-beginning 0))) + (end (match-end 0))) + (if (memq 'native org-highlight-latex-and-related) + (org-src-font-lock-fontify-block "latex" start end) + (font-lock-prepend-text-property start end + 'face 'org-latex-and-related)) + (add-text-properties (+ offset (match-beginning 0)) (match-end 0) + '(font-lock-multiline t)) + (throw 'found t))))) + nil)))) (defun org-restart-font-lock () "Restart `font-lock-mode', to force refontification." @@ -5636,15 +5642,22 @@ needs to be inserted at a specific position in the font-lock sequence.") (list (format org-heading-keyword-regexp-format org-todo-regexp) '(2 (org-get-todo-face 2) t)) + ;; TODO + (when org-fontify-todo-headline + (list (format org-heading-keyword-regexp-format + (concat + "\\(?:" + (mapconcat 'regexp-quote org-not-done-keywords "\\|") + "\\)")) + '(2 'org-headline-todo t))) ;; DONE - (if org-fontify-done-headline - (list (format org-heading-keyword-regexp-format - (concat - "\\(?:" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)")) - '(2 'org-headline-done t)) - nil) + (when org-fontify-done-headline + (list (format org-heading-keyword-regexp-format + (concat + "\\(?:" + (mapconcat 'regexp-quote org-done-keywords "\\|") + "\\)")) + '(2 'org-headline-done t))) ;; Priorities '(org-font-lock-add-priority-faces) ;; Tags @@ -5778,20 +5791,17 @@ needs to be inserted at a specific position in the font-lock sequence.") (org-font-lock-ensure) (buffer-string)))) -(defvar org-m nil) -(defvar org-l nil) -(defvar org-f nil) (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)) - (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 (unless org-level-color-stars-only org-f)))) + (let* ((org-l0 (- (match-end 2) (match-beginning 1) 1)) + (org-l (if org-odd-levels-only (1+ (/ org-l0 2)) org-l0)) + (org-f (if org-cycle-level-faces + (nth (% (1- org-l) org-n-level-faces) org-level-faces) + (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 (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. @@ -5826,11 +5836,13 @@ If TAG is a number, get the corresponding match group." 'tag 'org-tag (cdr (assoc tag org-tag-faces))) 'org-tag))) +(defvar org-priority-regexp) ; defined later in the file + (defun org-font-lock-add-priority-faces (limit) "Add the special priority faces." - (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t) + (while (re-search-forward org-priority-regexp limit t) (add-text-properties - (match-beginning 1) (match-end 1) + (match-beginning 1) (1+ (match-end 2)) (list 'face (org-get-priority-face (string-to-char (match-string 2))) 'font-lock-fontified t)))) @@ -5914,7 +5926,7 @@ and subscripts." "Remove outline overlays that do not contain non-white stuff." (dolist (o (overlays-at pos)) (and (eq 'outline (overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (overlay-start o) + (not (string-match-p "\\S-" (buffer-substring (overlay-start o) (overlay-end o)))) (delete-overlay o)))) @@ -5963,21 +5975,37 @@ open and agenda-wise Org files." ;;;; Headlines visibility (defun org-show-entry () - "Show the body directly following this heading. + "Show the body directly following its heading. Show the heading too, if it is currently invisible." (interactive) (save-excursion - (ignore-errors - (org-back-to-heading t) - (org-flag-region - (line-end-position 0) - (save-excursion - (if (re-search-forward - (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) - (match-beginning 1) - (point-max))) - nil - 'outline)))) + (org-back-to-heading-or-point-min t) + (org-flag-region + (line-end-position 0) + (save-excursion + (if (re-search-forward + (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) + (match-beginning 1) + (point-max))) + nil + 'outline) + (org-cycle-hide-drawers 'children))) + +(defun org-hide-entry () + "Hide the body directly following its heading." + (interactive) + (save-excursion + (org-back-to-heading-or-point-min t) + (when (org-at-heading-p) (forward-line)) + (org-flag-region + (line-end-position 0) + (save-excursion + (if (re-search-forward + (concat "[\r\n]" org-outline-regexp) nil t) + (line-end-position 0) + (point-max))) + t + 'outline))) (defun org-show-children (&optional level) "Show all direct subheadings of this heading. @@ -5985,36 +6013,37 @@ 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") - (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. - (org-flag-heading 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)) - (org-flag-heading nil))))) + (unless (org-before-first-heading-p) + (save-excursion + (org-with-limited-levels (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. + (org-flag-heading 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)) + (org-flag-heading nil)))))) (defun org-show-subtree () "Show everything after this heading at deeper levels." @@ -6022,117 +6051,135 @@ heading to appear." (org-flag-region (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) -;;;; Blocks visibility +;;;; Blocks and drawers visibility -(defun org-hide-block-toggle-maybe () - "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) - (ignore-errors (org-hide-block-toggle))) +(defun org--hide-wrapper-toggle (element category force no-error) + "Toggle visibility for ELEMENT. -(defun org-hide-block-toggle (&optional force) +ELEMENT is a block or drawer type parsed element. CATEGORY is +either `block' or `drawer'. When FORCE is `off', show the block +or drawer. If it is non-nil, hide it unconditionally. Throw an +error when not at a block or drawer, unless NO-ERROR is non-nil. + +Return a non-nil value when toggling is successful." + (let ((type (org-element-type element))) + (cond + ((memq type + (pcase category + (`drawer '(drawer property-drawer)) + (`block '(center-block + comment-block dynamic-block example-block export-block + quote-block special-block src-block verse-block)) + (_ (error "Unknown category: %S" category)))) + (let* ((post (org-element-property :post-affiliated element)) + (start (save-excursion + (goto-char post) + (line-end-position))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \t\n") + (line-end-position)))) + ;; Do nothing when not before or at the block opening line or + ;; at the block closing line. + (unless (let ((eol (line-end-position))) + (and (> eol start) (/= eol end))) + (let* ((spec (if (eq category 'block) 'org-hide-block 'outline)) + (flag + (cond ((eq force 'off) nil) + (force t) + ((eq spec (get-char-property start 'invisible)) nil) + (t t)))) + (org-flag-region start end flag spec)) + ;; When the block is hidden away, make sure point is left in + ;; a visible part of the buffer. + (when (invisible-p (max (1- (point)) (point-min))) + (goto-char post)) + ;; Signal success. + t))) + (no-error nil) + (t + (user-error (if (eq category 'drawer) + "Not at a drawer" + "Not at a block")))))) + +(defun org-hide-block-toggle (&optional force no-error element) "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) - (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* ((post (org-element-property :post-affiliated element)) - (start (save-excursion - (goto-char post) - (line-end-position))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \t\n") - (line-end-position)))) - ;; Do nothing when not before or at the block opening line or at - ;; the block closing line. - (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end))) - (cond ((eq force 'off) - (org-flag-region start end nil 'org-hide-block)) - (force - (org-flag-region start end t 'org-hide-block)) - ((eq (get-char-property start 'invisible) 'org-hide-block) - (org-flag-region start end nil 'org-hide-block)) - (t - (org-flag-region start end t 'org-hide-block))) - ;; When the block is hidden away, make sure point is left in - ;; a visible part of the buffer. - (when (invisible-p (max (1- (point)) (point-min))) - (goto-char post)) - ;; Signal success. - t)))) +a block, unless NO-ERROR is non-nil. When optional argument +ELEMENT is provided, consider it instead of the current block. -(defun org-hide-block-toggle-all () - "Toggle the visibility of all blocks in the current buffer." - (org-block-map 'org-hide-block-toggle)) +Return a non-nil value when toggling is successful." + (interactive) + (org--hide-wrapper-toggle + (or element (org-element-at-point)) 'block force no-error)) + +(defun org-hide-drawer-toggle (&optional force no-error element) + "Toggle the visibility of the current drawer. + +When optional argument FORCE is `off', make drawer visible. If +it is non-nil, hide it unconditionally. Throw an error when not +at a drawer, unless NO-ERROR is non-nil. When optional argument +ELEMENT is provided, consider it instead of the current drawer. + +Return a non-nil value when toggling is successful." + (interactive) + (org--hide-wrapper-toggle + (or element (org-element-at-point)) 'drawer force no-error)) (defun org-hide-block-all () "Fold all blocks in the current buffer." (interactive) (org-show-all '(blocks)) - (org-block-map 'org-hide-block-toggle-maybe)) + (org-block-map 'org-hide-block-toggle)) -;;;; Drawers visibility +(defun org-hide-drawer-all () + "Fold all drawers in the current buffer." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (let* ((pair (get-char-property-and-overlay (line-beginning-position) + 'invisible)) + (o (cdr-safe pair))) + (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) (goto-char (overlay-end o))) ;already folded + (_ + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer))) + (when (memq type '(drawer property-drawer)) + (org-hide-drawer-toggle t nil 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-cycle-hide-drawers (state &optional exceptions) +(defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change. 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." +`org-cycle-hook'." (when (and (derived-mode-p 'org-mode) (not (memq state '(overview folded contents)))) - (save-excursion - (let* ((globalp (eq state 'all)) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) - (if (eq state 'children) - (save-excursion (outline-next-heading) (point)) - (org-end-of-subtree t))))) + (let* ((global? (eq state 'all)) + (beg (if global? (point-min) (line-beginning-position))) + (end (cond (global? (point-max)) + ((eq state 'children) (org-entry-end-position)) + (t (save-excursion (org-end-of-subtree t t)))))) + (save-excursion (goto-char beg) - (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 beg end) - "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. - -When buffer positions BEG and END are provided, hide or show that -region as a drawer without further ado." - (if (and beg end) (org-flag-region beg end flag 'org-hide-drawer) - (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))) - (org-flag-region - (save-excursion (goto-char post) (line-end-position)) - (save-excursion (goto-char (org-element-property :end drawer)) - (skip-chars-backward " \t\n") - (line-end-position)) - flag 'org-hide-drawer) - ;; When the drawer is hidden away, make sure point lies in - ;; a visible part of the buffer. - (when (invisible-p (max (1- (point)) (point-min))) - (goto-char post))))))) + (while (re-search-forward org-drawer-regexp end t) + (pcase (get-char-property-and-overlay (point) 'invisible) + ;; Do not fold already folded drawers. + (`(outline . ,o) (goto-char (overlay-end o))) + (_ + (let ((drawer (org-element-at-point))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (org-hide-drawer-toggle t nil 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))))))))))) ;;;; Visibility cycling @@ -6147,13 +6194,31 @@ By default, the function expands headings, blocks and drawers. When optional argument TYPE is a list of symbols among `blocks', `drawers' and `headings', to only expand one specific type." (interactive) - (dolist (type (or types '(blocks drawers headings))) - (org-flag-region (point-min) (point-max) nil - (pcase type - (`blocks 'org-hide-block) - (`drawers 'org-hide-drawer) - (`headings 'outline) - (_ (error "Invalid type: %S" type)))))) + (let ((types (or types '(blocks drawers headings)))) + (when (memq 'blocks types) + (org-flag-region (point-min) (point-max) nil 'org-hide-block)) + (cond + ;; Fast path. Since headings and drawers share the same + ;; invisible spec, clear everything in one go. + ((and (memq 'headings types) + (memq 'drawers types)) + (org-flag-region (point-min) (point-max) nil 'outline)) + ((memq 'headings types) + (org-flag-region (point-min) (point-max) nil 'outline) + (org-cycle-hide-drawers 'all)) + ((memq 'drawers types) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (let* ((pair (get-char-property-and-overlay (line-beginning-position) + 'invisible)) + (o (cdr-safe pair))) + (if (overlayp o) (goto-char (overlay-end o)) + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (goto-char (overlay-end o)) + (delete-overlay o)) + (_ nil)))))))))) ;;;###autoload (defun org-cycle (&optional arg) @@ -6204,11 +6269,11 @@ 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." +As a special case, if point is at the very beginning of the buffer, if +there is no headline there, and if the variable `org-cycle-global-at-bob' +is non-nil, this function acts as if called with prefix argument \ +\(`\\[universal-argument] TAB', +same as `S-TAB') also when called without prefix argument." (interactive "P") (org-load-modules-maybe) (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) @@ -6220,63 +6285,22 @@ if the variable `org-cycle-global-at-bob' is t." (and (boundp 'org-inlinetask-min-level) org-inlinetask-min-level (1- org-inlinetask-min-level)))) - (nstars (and limit-level - (if org-odd-levels-only - (and limit-level (1- (* limit-level 2))) - limit-level))) + (nstars + (and limit-level + (if org-odd-levels-only + (1- (* 2 limit-level)) + limit-level))) (org-outline-regexp - (if (not (derived-mode-p 'org-mode)) - outline-regexp - (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) - (bob-special (and org-cycle-global-at-bob (not arg) (bobp) - (not (looking-at org-outline-regexp)))) - (org-cycle-hook - (if bob-special - (delq 'org-optimize-window-after-visibility-change - (copy-sequence org-cycle-hook)) - org-cycle-hook)) - (pos (point))) - + (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) (cond - ((equal arg '(16)) (setq last-command 'dummy) (org-set-startup-visibility) (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) - ((equal arg '(64)) (org-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" (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)) - - ;; Global cycling: delegate to `org-cycle-internal-global'. - (bob-special (org-cycle-internal-global)) - - ;; Drawers: delegate to `org-flag-drawer'. - ((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. ((integerp arg) (save-excursion @@ -6284,52 +6308,79 @@ Use `\\[org-edit-special]' to edit table.el tables")) (outline-up-heading (if (< arg 0) (- arg) (- (funcall outline-level) arg))) (org-show-subtree))) - + ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. + ((and org-cycle-global-at-bob + (bobp) + (not (looking-at org-outline-regexp))) + (let ((org-cycle-hook + (remq 'org-optimize-window-after-visibility-change + org-cycle-hook))) + (org-cycle-internal-global))) + ;; Try CDLaTeX TAB completion. + ((org-try-cdlatex-tab)) ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. ((and (featurep 'org-inlinetask) (org-inlinetask-at-task-p) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) (org-inlinetask-toggle-visibility)) - - ;; At an item/headline: delegate to `org-cycle-internal-local'. - ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) - (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)) - - ;; From there: TAB emulation and template completion. - (buffer-read-only (org-back-to-heading)) - - ((run-hook-with-args-until-success - 'org-tab-after-check-for-cycling-hook)) - - ((run-hook-with-args-until-success - 'org-tab-before-tab-emulation-hook)) - - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at org-outline-regexp)))) - (call-interactively (global-key-binding "\t"))) - - ((if (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) - (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) - (and (eq org-cycle-emulate-tab 'whitestart) - (>= (match-end 0) pos)))) - t - (eq org-cycle-emulate-tab t)) - (call-interactively (global-key-binding "\t"))) - - (t (save-excursion - (org-back-to-heading) - (org-cycle))))))) + (t + (let ((pos (point)) + (element (org-element-at-point))) + (cond + ;; Try toggling visibility for block at point. + ((org-hide-block-toggle nil t element)) + ;; Try toggling visibility for drawer at point. + ((org-hide-drawer-toggle nil t element)) + ;; Table: enter it or move to the next field. + ((and (org-match-line "[ \t]*[|+]") + (org-element-lineage element '(table) t)) + (if (and (eq 'table (org-element-type element)) + (eq 'table.el (org-element-property :type element))) + (message (substitute-command-keys "\\\ +Use `\\[org-edit-special]' to edit table.el tables")) + (org-table-justify-field-maybe) + (call-interactively #'org-table-next-field))) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-table-hook)) + ;; At an item/headline: delegate to `org-cycle-internal-local'. + ((and (or (and org-cycle-include-plain-lists + (let ((item (org-element-lineage element + '(item plain-list) + t))) + (and item + (= (line-beginning-position) + (org-element-property :post-affiliated + item))))) + (org-match-line org-outline-regexp)) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-cycle-internal-local)) + ;; From there: TAB emulation and template completion. + (buffer-read-only (org-back-to-heading)) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-cycling-hook)) + ((run-hook-with-args-until-success + 'org-tab-before-tab-emulation-hook)) + ((and (eq org-cycle-emulate-tab 'exc-hl-bol) + (or (not (bolp)) + (not (looking-at org-outline-regexp)))) + (call-interactively (global-key-binding (kbd "TAB")))) + ((or (eq org-cycle-emulate-tab t) + (and (memq org-cycle-emulate-tab '(white whitestart)) + (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (or (and (eq org-cycle-emulate-tab 'white) + (= (match-end 0) (point-at-eol))) + (and (eq org-cycle-emulate-tab 'whitestart) + (>= (match-end 0) pos))))) + (call-interactively (global-key-binding (kbd "TAB")))) + (t + (save-excursion + (org-back-to-heading) + (org-cycle)))))))))) (defun org-cycle-internal-global () "Do the global cycling action." ;; Hack to avoid display of messages for .org attachments in Gnus - (let ((ga (string-match "\\*fontification" (buffer-name)))) + (let ((ga (string-match-p "\\*fontification" (buffer-name)))) (cond ((and (eq last-command this-command) (eq org-cycle-global-status 'overview)) @@ -6377,19 +6428,23 @@ Use `\\[org-edit-special]' to edit table.el tables")) (setq has-children (org-list-has-child-p (point) struct))) (org-back-to-heading) (setq eoh (save-excursion (outline-end-of-heading) (point))) - (setq eos (save-excursion (org-end-of-subtree t t) - (when (bolp) (backward-char)) (point))) + (setq eos (save-excursion + (org-end-of-subtree t t) + (unless (eobp) (forward-char -1)) + (point))) (setq has-children - (or (save-excursion - (let ((level (funcall outline-level))) - (outline-next-heading) - (and (org-at-heading-p t) - (> (funcall outline-level) level)))) - (save-excursion - (org-list-search-forward (org-item-beginning-re) eos t))))) + (or + (save-excursion + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (org-at-heading-p t) + (> (funcall outline-level) level)))) + (and (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-list-search-forward (org-item-beginning-re) eos t)))))) ;; Determine end invisible part of buffer (EOL) (beginning-of-line 2) - (while (and (not (eobp)) ;This is like `next-line'. + (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))) @@ -6467,18 +6522,15 @@ Use `\\[org-edit-special]' to edit table.el tables")) 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) - (org-show-all '(headings blocks)) - (outline-hide-sublevels arg) - (setq org-cycle-global-status 'contents)) - ((equal arg '(4)) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) - (t - (org-cycle '(4)))))) + (cond + ((integerp arg) + (org-content arg) + (setq org-cycle-global-status 'contents)) + ((equal arg '(4)) + (org-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) + (t + (org-cycle '(4))))) (defun org-set-startup-visibility () "Set the visibility required by startup options and properties." @@ -6526,51 +6578,60 @@ With a numeric prefix, show all headlines up to that level." (org-end-of-subtree))))))) (defun org-overview () - "Switch to overview mode, showing only top-level headlines. -This shows all headlines with a level equal or greater than the level -of the first headline in the buffer. This is important, because if the -first headline is not level one, then (hide-sublevels 1) gives confusing -results." + "Switch to overview mode, showing only top-level headlines." (interactive) + (org-show-all '(headings drawers)) (save-excursion - (let ((level - (save-excursion - (goto-char (point-min)) - (when (re-search-forward org-outline-regexp-bol nil t) - (goto-char (match-beginning 0)) - (funcall outline-level))))) - (and level (outline-hide-sublevels level))))) + (goto-char (point-min)) + (when (re-search-forward org-outline-regexp-bol nil t) + (let* ((last (line-end-position)) + (level (- (match-end 0) (match-beginning 0) 1)) + (regexp (format "^\\*\\{1,%d\\} " level))) + (while (re-search-forward regexp nil :move) + (org-flag-region last (line-end-position 0) t 'outline) + (setq last (line-end-position)) + (setq level (- (match-end 0) (match-beginning 0) 1)) + (setq regexp (format "^\\*\\{1,%d\\} " level))) + (org-flag-region last (point) t 'outline))))) (defun org-content (&optional arg) "Show all headlines in the buffer, like a table of contents. With numerical argument N, show content up to level N." - (interactive "P") - (org-overview) + (interactive "p") + (org-show-all '(headings drawers)) (save-excursion - ;; Visit all headings and show their offspring - (and (integerp arg) (org-overview)) (goto-char (point-max)) - (catch 'exit - (while (and (progn (condition-case nil - (outline-previous-visible-heading 1) - (error (goto-char (point-min)))) - t) - (looking-at org-outline-regexp)) - (if (integerp arg) - (org-show-children (1- arg)) - (outline-show-branches)) - (when (bobp) (throw 'exit nil)))))) + (let ((regexp (if (and (wholenump arg) (> arg 0)) + (format "^\\*\\{1,%d\\} " arg) + "^\\*+ ")) + (last (point))) + (while (re-search-backward regexp nil t) + (org-flag-region (line-end-position) last t 'outline) + (setq last (line-end-position 0)))))) +(defvar org-scroll-position-to-restore nil + "Temporarily store scroll position to restore.") (defun org-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. This function is the default value of the hook `org-cycle-hook'." (when (get-buffer-window (current-buffer)) - (cond - ((eq state 'content) nil) - ((eq state 'all) nil) - ((eq state 'folded) nil) - ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) + (let ((repeat (eq last-command this-command))) + (unless repeat + (setq org-scroll-position-to-restore nil)) + (cond + ((eq state 'content) nil) + ((eq state 'all) nil) + ((and org-scroll-position-to-restore repeat + (eq state 'folded)) + (set-window-start nil org-scroll-position-to-restore)) + ((eq state 'folded) nil) + ((eq state 'children) + (setq org-scroll-position-to-restore (window-start)) + (or (org-subtree-end-visible-p) (recenter 1))) + ((eq state 'subtree) + (unless repeat + (setq org-scroll-position-to-restore (window-start))) + (or (org-subtree-end-visible-p) (recenter 1))))))) (defun org-clean-visibility-after-subtree-move () "Fix visibility issues after moving a subtree." @@ -6671,8 +6732,7 @@ information." ;; 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 org-hide-drawer outline)) + (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) (delete-overlay o))) (unless (org-before-first-heading-p) (org-with-limited-levels @@ -6785,7 +6845,7 @@ frame is not changed." (pop-to-buffer ibuf)) (t (error "Invalid value"))) (narrow-to-region beg end) - (org-show-all '(headings blocks)) + (org-show-all '(headings drawers blocks)) (goto-char pos) (run-hook-with-args 'org-cycle-hook 'all) (and (window-live-p cwin) (select-window cwin)))) @@ -6812,27 +6872,6 @@ frame is not changed." ;;; Inserting headlines -(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 n) t) - (save-match-data - (looking-at "[ \t]*$"))))) - -(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)) - -(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)) - (defun org--blank-before-heading-p (&optional parent) "Non-nil when an empty line should precede a new heading here. When optional argument PARENT is non-nil, consider parent @@ -7344,9 +7383,17 @@ Assume point is at a heading or an inlinetask beginning." (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)))) + (org-indent-region (match-beginning 0) (match-end 0))) + (when (looking-at org-logbook-drawer-re) + (let ((end-marker (move-marker (make-marker) (match-end 0))) + (col (+ (current-indentation) diff))) + (when (wholenump col) + (while (< (point) end-marker) + (indent-line-to col) + (forward-line))))) (catch 'no-shift - (when (zerop diff) (throw 'no-shift nil)) + (when (or (zerop diff) (not (eq org-adapt-indentation t))) + (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. @@ -7761,8 +7808,9 @@ If yes, remember the marker and the distance to BEG." "Narrow to the subtree at point or widen a narrowed buffer." (interactive) (if (buffer-narrowed-p) - (widen) - (org-narrow-to-subtree))) + (progn (widen) (message "Buffer widen")) + (org-narrow-to-subtree) + (message "Buffer narrowed to current subtree"))) (defun org-narrow-to-block () "Narrow buffer to the current block." @@ -7843,7 +7891,8 @@ with the original repeater." (nmin 1) (nmax n) (n-no-remove -1) - (idprop (org-entry-get nil "ID"))) + (org-id-overriding-file-name (buffer-file-name (buffer-base-buffer))) + (idprop (org-entry-get beg "ID"))) (when (and doshift (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) @@ -7885,6 +7934,131 @@ with the original repeater." (buffer-string))))) (goto-char beg))) +;;; Outline path + +(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--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. +WIDTH is the maximum number of characters that is available. +PREFIX is a prefix to be included in the returned string, +such as the file name. +SEPARATOR is inserted between the different parts of the path, +the default is \"/\"." + (setq width (or width 79)) + (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. + +If FILE is non-nil, prepend the output with the file name. +If CURRENT is non-nil, append the current heading to the output. +SEPARATOR is passed through to `org-format-outline-path'. It separates +the different parts of the path and defaults to \"/\". +If JUST-RETURN-STRING is non-nil, return a string, don't display a message." + (interactive "P") + (let* (case-fold-search + (bfn (buffer-file-name (buffer-base-buffer))) + (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) + res) + (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 + path + (1- (frame-width)) + (and file bfn (concat (file-name-nondirectory bfn) separator)) + separator)) + (add-face-text-property 0 (length res) + `(:height ,(face-attribute 'default :height)) + nil res) + (if just-return-string + res + (org-unlogged-message "%s" res)))) + ;;; Outline Sorting (defun org-sort (&optional with-case) @@ -7907,8 +8081,6 @@ Optional argument WITH-CASE means sort case-sensitively." (org-link-display-format s) t t) t t)) -(defvar org-priority-regexp) ; defined later in the file - (defvar org-after-sorting-entries-or-items-hook nil "Hook that is run after a bunch of entries or items have been sorted. When children are sorted, the cursor is in the parent line when this @@ -8002,7 +8174,7 @@ function is being called interactively." (setq end (point-max)) (setq what "top-level") (goto-char start) - (org-show-all '(headings blocks)))) + (org-show-all '(headings drawers blocks)))) (setq beg (point)) (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) @@ -8112,7 +8284,7 @@ function is being called interactively." ((= dcst ?p) (if (re-search-forward org-priority-regexp (point-at-eol) t) (string-to-char (match-string 2)) - org-default-priority)) + org-priority-default)) ((= dcst ?r) (or (org-entry-get nil property) "")) ((= dcst ?o) @@ -8269,13 +8441,14 @@ the value of the drawer property." (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)))) + (global-or-keyword (and inherit? + (org--property-global-or-keyword-value dprop nil)))) (with-silent-modifications (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. + ;; Set global and keyword based values to the whole buffer. + (when global-or-keyword + (put-text-property (point-min) (point-max) tprop global-or-keyword)) + ;; Set values based on property-drawers throughout the document. (while (re-search-forward property-re nil t) (when (org-at-property-p) (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) @@ -8283,21 +8456,30 @@ the value of the drawer property." (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)))))))) + +The refresh happens only for the current entry, or the whole +sub-tree if optional argument INHERIT is non-nil. + +If point is before first headline, the function applies to the +part before the first headline. In that particular case, when +optional argument INHERIT is non-nil, it refreshes properties for +the whole buffer." + (save-excursion + (org-back-to-heading-or-point-min t) + (let ((start (point)) + (end (save-excursion + (cond ((and inherit (org-before-first-heading-p)) + (point-max)) + (inherit + (org-end-of-subtree t t)) + ((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." @@ -8313,9 +8495,9 @@ sub-tree if optional argument INHERIT is non-nil." (t org-category)))) (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. + ;; Set buffer-wide property from keyword. Search last #+CATEGORY + ;; keyword. If none is found, fall-back to `org-category' or + ;; buffer file name, or set it by the document property drawer. (put-text-property (point-min) (point-max) 'org-category @@ -8327,15 +8509,20 @@ sub-tree if optional argument INHERIT is non-nil." (throw 'buffer-category (org-element-property :value element))))) default-category)) - ;; Set sub-tree specific categories. + ;; Set categories from the document property drawer or + ;; property drawers in the outline. If category is found in + ;; the property drawer for the whole buffer that value + ;; overrides the keyword-based value set above. (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)) + (save-excursion (org-back-to-heading-or-point-min t)) + (save-excursion (if (org-before-first-heading-p) + (point-max) + (org-end-of-subtree t t))) 'org-category value))))))))) @@ -8659,31 +8846,30 @@ a link." ;; 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 - (save-excursion - (let* ((beg (match-beginning 5)) - (end (match-end 5)) - (beg-tag (or (search-backward ":" beg 'at-limit) (point))) - (end-tag (search-forward ":" end nil 2))) - (buffer-substring (1+ beg-tag) (1- end-tag))))) - ;; Not on tags. - (pcase (org-offer-links-in-entry (current-buffer) (point) arg) - (`(nil . ,_) - (require 'org-attach) - (message "Opening attachment-dir") - (if (equal arg '(4)) - (org-attach-reveal-in-emacs) - (org-attach-reveal))) - (`(,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 arg)))))) + (let ((tags-beg (match-beginning 5)) + (tags-end (match-end 5))) + (if (and tags-beg (>= (point) tags-beg) (< (point) tags-end)) + ;; On tags. + (org-tags-view + arg + (save-excursion + (let* ((beg-tag (or (search-backward ":" tags-beg 'at-limit) (point))) + (end-tag (search-forward ":" tags-end nil 2))) + (buffer-substring (1+ beg-tag) (1- end-tag))))) + ;; Not on tags. + (pcase (org-offer-links-in-entry (current-buffer) (point) arg) + (`(nil . ,_) + (require 'org-attach) + (when (org-attach-dir) + (message "Opening attachment") + (if (equal arg '(4)) + (org-attach-reveal-in-emacs) + (org-attach-reveal)))) + (`(,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 arg))))))) ;; On a footnote reference or at definition's label. ((or (eq type 'footnote-reference) (and (eq type 'footnote-definition) @@ -8903,639 +9089,10 @@ or to another Org file, automatically push the old position onto the ring." (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'.") - (defvar org-agenda-new-buffers nil "Buffers created to visit agenda files.") -(defvar org-refile-cache nil - "Cache for refile targets.") - -(defvar org-refile-markers nil - "All the markers used for caching refile locations.") - -(defun org-refile-marker (pos) - "Get a new refile marker, but only if caching is in use." - (if (not org-refile-use-cache) - pos - (let ((m (make-marker))) - (move-marker m pos) - (push m org-refile-markers) - m))) - -(defun org-refile-cache-clear () - "Clear the refile cache and disable all the 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")) - -(defun org-refile-cache-check-set (set) - "Check if all the markers in the cache still have live buffers." - (let (marker) - (catch 'exit - (while (and set (setq marker (nth 3 (pop set)))) - ;; If `org-refile-use-outline-path' is 'file, marker may be nil - (when (and marker (null (marker-buffer marker))) - (message "Please regenerate the refile cache with `C-0 C-c C-w'") - (sit-for 3) - (throw 'exit nil))) - t))) - -(defun org-refile-cache-put (set &rest identifiers) - "Push the refile targets SET into the cache, under IDENTIFIERS." - (let* ((key (sha1 (prin1-to-string identifiers))) - (entry (assoc key org-refile-cache))) - (if entry - (setcdr entry set) - (push (cons key set) org-refile-cache)))) - -(defun org-refile-cache-get (&rest identifiers) - "Retrieve the cached value for refile targets given by IDENTIFIERS." - (cond - ((not org-refile-cache) nil) - ((not org-refile-use-cache) (org-refile-cache-clear) nil) - (t - (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) - org-refile-cache)))) - (and set (org-refile-cache-check-set set) set))))) - -(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 files desc descre) - (message "Getting targets...") - (with-current-buffer (or default-buffer (current-buffer)) - (dolist (entry entries) - (setq files (car entry) desc (cdr entry)) - (cond - ((null files) (setq files (list (current-buffer)))) - ((eq files 'org-agenda-files) - (setq files (org-agenda-files 'unrestricted))) - ((and (symbolp files) (fboundp files)) - (setq files (funcall files))) - ((and (symbolp files) (boundp files)) - (setq files (symbol-value files)))) - (when (stringp files) (setq files (list files))) - (cond - ((eq (car desc) :tag) - (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) - ((eq (car desc) :todo) - (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) - ((eq (car desc) :regexp) - (setq descre (cdr desc))) - ((eq (car desc) :level) - (setq descre (concat "^\\*\\{" (number-to-string - (if org-odd-levels-only - (1- (* 2 (cdr desc))) - (cdr desc))) - "\\}[ \t]"))) - ((eq (car desc) :maxlevel) - (setq descre (concat "^\\*\\{1," (number-to-string - (if org-odd-levels-only - (1- (* 2 (cdr desc))) - (cdr desc))) - "\\}[ \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)) - (or - (setq tgs (org-refile-cache-get (buffer-file-name) descre)) - (progn - (when (bufferp f) - (setq f (buffer-file-name (buffer-base-buffer f)))) - (setq f (and f (expand-file-name f))) - (when (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) tgs)) - (when (eq org-refile-use-outline-path 'buffer-name) - (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs)) - (when (eq org-refile-use-outline-path 'full-file-path) - (push (list (file-truename (buffer-file-name (buffer-base-buffer))) 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 - #'identity - (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)))) - (`buffer-name - (list (buffer-name - (buffer-base-buffer)))) - (_ nil)) - (mapcar (lambda (s) (replace-regexp-in-string - "/" "\\/" s nil t)) - (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") - (delete-dups (nreverse targets)))) - -(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. -WIDTH is the maximum number of characters that is available. -PREFIX is a prefix to be included in the returned string, -such as the file name. -SEPARATOR is inserted between the different parts of the path, -the default is \"/\"." - (setq width (or width 79)) - (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. - -If FILE is non-nil, prepend the output with the file name. -If CURRENT is non-nil, append the current heading to the output. -SEPARATOR is passed through to `org-format-outline-path'. It separates -the different parts of the path and defaults to \"/\". -If JUST-RETURN-STRING is non-nil, return a string, don't display a message." - (interactive "P") - (let* (case-fold-search - (bfn (buffer-file-name (buffer-base-buffer))) - (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) - res) - (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 - path - (1- (frame-width)) - (and file bfn (concat (file-name-nondirectory bfn) separator)) - separator)) - (if just-return-string - (org-no-properties res) - (org-unlogged-message "%s" res)))) - -(defvar org-refile-history nil - "History for refiling operations.") - -(defvar org-after-refile-insert-hook nil - "Hook run after `org-refile' has inserted its stuff at the new location. -Note that this is still *before* the stuff will be removed from -the *old* location.") - -(defvar org-capture-last-stored-marker) -(defvar org-refile-keep nil - "Non-nil means `org-refile' will copy instead of refile.") - -(defun org-copy () - "Like `org-refile', but copy." - (interactive) - (let ((org-refile-keep t)) - (org-refile nil nil nil "Copy"))) - -(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. - -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 a `\\[universal-argument]' ARG, the command will only visit the target \ -location -and not actually move anything. - -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. - -With a numeric prefix argument of `3', emulate `org-refile-keep' -being set to t and copy to the target location, don't move it. -Beware that keeping refiled entries may result in duplicated ID -properties. - -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'. - -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 arg '(0 (64))) - (org-refile-cache-clear) - (let* ((actionmsg (cond (msg msg) - ((equal arg 3) "Refile (and keep)") - (t "Refile"))) - (regionp (org-region-active-p)) - (region-start (and regionp (region-beginning))) - (region-end (and regionp (region-end))) - (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) - (beginning-of-line) - (setq region-start (point)) - (unless (or (org-kill-is-subtree-p - (buffer-substring region-start region-end)) - (prog1 org-refile-active-region-within-subtree - (let ((s (point-at-eol))) - (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 arg '(16)) - (org-refile-goto-last-stored) - (when (or - (and (equal arg 2) - org-clock-hd-marker (marker-buffer org-clock-hd-marker) - (prog1 - (setq it (list (or org-clock-heading "running clock") - (buffer-file-name - (marker-buffer org-clock-hd-marker)) - "" - (marker-position org-clock-hd-marker))) - (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-link-bracket-re - "\\2" - (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) - pos (nth 3 it)) - (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 arg (not (equal arg 3))) - (progn - (pop-to-buffer-same-window nbuf) - (goto-char (cond (pos) - ((org-notes-order-reversed-p) (point-min)) - (t (point-max)))) - (org-show-context 'org-goto)) - (if regionp - (progn - (org-kill-new (buffer-substring region-start region-end)) - (org-save-markers-in-region region-start region-end)) - (org-copy-subtree 1 nil t)) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (setq reversed (org-notes-order-reversed-p)) - (org-with-wide-buffer - (if pos - (progn - (goto-char pos) - (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) - ;; Record information, according to `org-log-refile'. - ;; Do not prompt for a note when refiling multiple - ;; headlines, however. Simply add a time stamp. - (cond - ((not org-log-refile)) - (regionp - (org-map-region - (lambda () (org-add-log-setup 'refile nil nil 'time)) - (point) - (+ (point) (- region-end region-start)))) - (t - (org-add-log-setup 'refile nil nil org-log-refile))) - (and org-auto-align-tags - (let ((org-loop-over-headlines-in-active-region nil)) - (org-align-tags))) - (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))) - (org-preserve-local-variables - (delete-region - (and (org-back-to-heading t) (point)) - (min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe)) - (setq org-markers-to-move nil) - (message "%s to \"%s\" in file %s: done" actionmsg - (car it) file))))))) - -(defun org-refile-goto-last-stored () - "Go to the location where the last refile was stored." - (interactive) - (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) - "When user refile to REFLOC, find the associated target in TBL. -Also check `org-refile-target-table'." - (car (delq - nil - (mapcar - (lambda (r) (or (assoc r tbl) - (assoc r 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) - "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." - (let ((org-refile-targets org-refile-targets) - (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)) - (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 - #'completing-read)) - (extra (if org-refile-use-outline-path "/" "")) - (cbnex (concat (buffer-name) extra)) - (filename (and cfn (expand-file-name cfn))) - (tbl (mapcar - (lambda (x) - (if (and (not (member org-refile-use-outline-path - '(file full-file-path))) - (not (equal filename (nth 1 x)))) - (cons (concat (car x) extra " (" - (file-name-nondirectory (nth 1 x)) ")") - (cdr x)) - (cons (concat (car x) extra) (cdr x)))) - org-refile-target-table)) - (completion-ignore-case t) - cdef - (prompt (concat prompt - (or (and (car org-refile-history) - (concat " (default " (car org-refile-history) ")")) - (and (assoc cbnex tbl) (setq cdef cbnex) - (concat " (default " cbnex ")"))) ": ")) - pa answ parent-target child parent old-hist) - (setq old-hist org-refile-history) - (setq answ (funcall cfunc prompt tbl nil (not new-nodes) - nil 'org-refile-history (or cdef (car org-refile-history)))) - (if (setq pa (org-refile--get-location answ tbl)) - (progn - (org-refile-check-position pa) - (when (or (not org-refile-history) - (not (eq old-hist org-refile-history)) - (not (equal (car pa) (car org-refile-history)))) - (setq org-refile-history - (cons (car pa) (if (assoc (car org-refile-history) tbl) - org-refile-history - (cdr org-refile-history)))) - (when (equal (car org-refile-history) (nth 1 org-refile-history)) - (pop org-refile-history))) - pa) - (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) - (progn - (setq parent (match-string 1 answ) - child (match-string 2 answ)) - (setq parent-target (org-refile--get-location parent tbl)) - (when (and parent-target - (or (eq new-nodes t) - (and (eq new-nodes 'confirm) - (y-or-n-p (format "Create new node \"%s\"? " - child))))) - (org-refile-new-child parent-target child))) - (user-error "Invalid target location"))))) - (declare-function org-string-nw-p "org-macs" (s)) -(defun org-refile-check-position (refile-pointer) - "Check if the refile pointer matches the headline to which it points." - (let* ((file (nth 1 refile-pointer)) - (re (nth 2 refile-pointer)) - (pos (nth 3 refile-pointer)) - buffer) - (if (and (not (markerp pos)) (not file)) - (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 - (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." - (unless parent-target - (error "Cannot find parent for new node")) - (let ((file (nth 1 parent-target)) - (pos (nth 3 parent-target)) - level) - (with-current-buffer (or (find-buffer-visiting file) - (find-file-noselect file)) - (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)) - (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 (defun org-find-dblock (name) @@ -9631,15 +9188,18 @@ block of such type." (`nil (push (cons type func) org-dynamic-block-alist)) (def (setcdr def func)))) -(defun org-dynamic-block-insert-dblock (type) +(defun org-dynamic-block-insert-dblock (type &optional interactive-p) "Insert a dynamic block of type TYPE. When used interactively, select the dynamic block types among -defined types, per `org-dynamic-block-define'." +defined types, per `org-dynamic-block-define'. If INTERACTIVE-P +is non-nil, call the dynamic block function interactively." (interactive (list (completing-read "Dynamic block: " - (org-dynamic-block-types)))) + (org-dynamic-block-types)) + t)) (pcase (org-dynamic-block-function type) (`nil (error "No such dynamic block: %S" type)) - ((and f (pred functionp)) (funcall f)) + ((and f (pred functionp)) + (if interactive-p (call-interactively f) (funcall f))) (_ (error "Invalid function for dynamic block %S" type)))) (defun org-dblock-update (&optional arg) @@ -9763,8 +9323,7 @@ block can be inserted by pressing TAB after the string \" (upcase new) org-lowest-priority)) - (user-error "Priority must be between `%c' and `%c'" - org-highest-priority org-lowest-priority)))) + ((or (< (upcase new) org-priority-highest) (> (upcase new) org-priority-lowest)) + (user-error + (if nump + "Priority must be between `%s' and `%s'" + "Priority must be between `%c' and `%c'") + org-priority-highest org-priority-lowest)))) ((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 + org-priority-lowest ; wrap around empty to lowest ;; default (if org-priority-start-cycle-with-default - org-default-priority - (1- org-default-priority)))))) + org-priority-default + (1- org-priority-default)))))) ((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 + org-priority-highest ; wrap around empty to highest ;; default (if org-priority-start-cycle-with-default - org-default-priority - (1+ org-default-priority)))))) + org-priority-default + (1+ org-priority-default)))))) (t (user-error "Invalid action"))) - (when (or (< (upcase new) org-highest-priority) - (> (upcase new) org-lowest-priority)) + (when (or (< (upcase new) org-priority-highest) + (> (upcase new) org-priority-lowest)) (if (and (memq action '(up down)) (not have) (not (eq last-command this-command))) ;; `new' is from default priority (error - "The default can not be set, see `org-default-priority' why") + "The default can not be set, see `org-priority-default' why") ;; normal cycling: `new' is beyond highest/lowest priority ;; and is wrapped around to the empty priority (setq remove t))) - (setq news (format "%c" new)) + ;; Numerical priorities are limited to 64, beyond that number, + ;; assume the priority cookie is a character. + (setq news (if (> new 64) (format "%c" new) (format "%s" new))) (if have (if remove (replace-match "" t t nil 1) @@ -11660,7 +11250,8 @@ or a character." (message "Priority removed") (message "Priority of current item set to %s" news))))) -(defun org-show-priority () +(defalias 'org-show-priority 'org-priority-show) +(defun org-priority-show () "Show the priority of the current item. This priority is composed of the main priority given with the [#A] cookies, and by additional input from the age of a schedules or deadline entry." @@ -11675,14 +11266,18 @@ and by additional input from the age of a schedules or deadline entry." (message "Priority is %d" (if pri pri -1000)))) (defun org-get-priority (s) - "Find priority cookie and return priority." + "Find priority cookie and return priority. +S is a string against which you can match `org-priority-regexp'. +If `org-priority-get-priority-function' is set to a custom +function, use it. Otherwise process S and output the priority +value, an integer." (save-match-data - (if (functionp org-get-priority-function) - (funcall org-get-priority-function s) + (if (functionp org-priority-get-priority-function) + (funcall org-priority-get-priority-function s) (if (not (string-match org-priority-regexp s)) - (* 1000 (- org-lowest-priority org-default-priority)) - (* 1000 (- org-lowest-priority - (string-to-char (match-string 2 s)))))))) + (* 1000 (- org-priority-lowest org-priority-default)) + (* 1000 (- org-priority-lowest + (org-priority-to-value (match-string 2 s)))))))) ;;;; Tags @@ -11907,7 +11502,7 @@ are also TODO tasks." (interactive "P") (org-agenda-prepare-buffers (list (current-buffer))) (let ((org--matcher-tags-todo-only todo-only)) - (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) + (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match t)) org--matcher-tags-todo-only))) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) @@ -11948,7 +11543,7 @@ instead of the agenda files." (if (car-safe files) files (org-agenda-files)))))))) -(defun org-make-tags-matcher (match) +(defun org-make-tags-matcher (match &optional only-local-tags) "Create the TAGS/TODO matcher form for the selection string MATCH. Returns a cons of the selection string MATCH and a function @@ -11966,6 +11561,9 @@ 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. +When ONLY-LOCAL-TAGS is non-nil, ignore the global tag completion +table, only get buffer tags. + See also `org-scan-tags'." (unless match ;; Get a new match request, with completion against the global @@ -11973,7 +11571,8 @@ See also `org-scan-tags'." (let ((org-last-tags-completion-table (org--tag-add-to-alist (org-get-buffer-tags) - (org-global-tags-completion-table)))) + (unless only-local-tags + (org-global-tags-completion-table))))) (setq match (completing-read "Match: " @@ -12100,7 +11699,7 @@ See also `org-scan-tags'." (cons match0 `(lambda (todo tags-list level) ,matcher))))) (defun org--tags-expand-group (group tag-groups expanded) - "Recursively Expand all tags in GROUP, according to TAG-GROUPS. + "Recursively expand all tags in GROUP, according to TAG-GROUPS. TAG-GROUPS is the list of groups used for expansion. EXPANDED is an accumulator used in recursive calls." (dolist (tag group) @@ -12148,7 +11747,9 @@ When DOWNCASED is non-nil, expand downcased TAGS." (if (not downcased) g (mapcar (lambda (s) (mapcar #'downcase s)) g))))) (cond - (single-as-list (org--tags-expand-group (list match) tag-groups nil)) + (single-as-list (org--tags-expand-group + (list (if downcased (downcase match) match)) + tag-groups nil)) (org-group-tags (let* ((case-fold-search t) (tag-syntax org-mode-syntax-table) @@ -12331,7 +11932,12 @@ in Lisp code use `org-set-tags' instead." #'org-tags-completion-function nil nil (org-make-tag-string current-tags) 'org-tags-history))))))) - (org-set-tags tags))))))) + (org-set-tags tags))))) + ;; `save-excursion' may not replace the point at the right + ;; position. + (when (and (save-excursion (skip-chars-backward "*") (bolp)) + (looking-at-p " ")) + (forward-char)))) (defun org-align-tags (&optional all) "Align tags in current entry. @@ -12712,7 +12318,8 @@ According to `org-use-tag-inheritance', tags may be inherited from parent headlines, and from the whole document, through `org-file-tags'. In this case, the returned list of tags contains tags in this order: file tags, tags inherited from -parent headlines, local tags. +parent headlines, local tags. If a tag appears multiple times, +only the most local tag is returned. However, when optional argument LOCAL is non-nil, only return tags specified at the headline. @@ -12728,12 +12335,13 @@ Inherited tags have the `inherited' text property." (let ((ltags (org--get-local-tags)) itags) (if (or local (not org-use-tag-inheritance)) ltags (while (org-up-heading-safe) - (setq itags (append (mapcar #'org-add-prop-inherited - (org--get-local-tags)) - itags))) + (setq itags (nconc (mapcar #'org-add-prop-inherited + (org--get-local-tags)) + itags))) (setq itags (append org-file-tags itags)) - (delete-dups - (append (org-remove-uninherited-tags itags) ltags)))))))) + (nreverse + (delete-dups + (nreverse (nconc (org-remove-uninherited-tags itags) ltags)))))))))) (defun org-get-buffer-tags () "Get a table of all tags used in the buffer, for completion." @@ -12921,30 +12529,52 @@ Modifications are made by side-effect. Return new alist." (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." +BEG is the beginning of the current subtree or the beginning of +the document if 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) + (let ((beg (cond (beg (goto-char 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)))))))) + (org-back-to-heading-or-point-min t) (point)) + (t (org-with-limited-levels + (org-back-to-heading-or-point-min t)) + (point))))) + ;; Move point to its position according to its positional rules. + (cond ((org-before-first-heading-p) + (while (and (org-at-comment-p) (bolp)) (forward-line))) + (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 (re-search-forward org-property-drawer-re) + (line-beginning-position)))) + (cons pos pos))))))) + +(defun org-at-property-drawer-p () + "Non-nil when point is at the first line of a property drawer." + (org-with-wide-buffer + (beginning-of-line) + (and (looking-at org-property-drawer-re) + (or (bobp) + (progn + (forward-line -1) + (cond ((org-at-heading-p)) + ((looking-at org-planning-line-re) + (forward-line -1) + (org-at-heading-p)) + ((looking-at org-comment-regexp) + (forward-line -1) + (while (and (not (bobp)) (looking-at org-comment-regexp)) + (forward-line -1)) + (looking-at org-comment-regexp)) + (t nil))))))) (defun org-at-property-p () "Non-nil when point is inside a property drawer. @@ -13000,6 +12630,10 @@ variables is set." (not (get-text-property 0 'org-unrestricted (caar allowed)))))) (completing-read "Effort: " allowed nil must-match)))))) + ;; Test whether the value can be interpreted as a duration before + ;; inserting it in the buffer: + (org-duration-to-minutes value) + ;; Maybe update the effort value: (unless (equal current value) (org-entry-put nil org-effort-property value)) (org-refresh-property '((effort . identity) @@ -13029,7 +12663,7 @@ 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))) + (org-back-to-heading-or-point-min t)) (catch 'exit (let* ((beg (point)) (specific (and (stringp which) (upcase which))) @@ -13072,7 +12706,7 @@ strings." (push (cons "PRIORITY" (if (looking-at org-priority-regexp) (match-string-no-properties 2) - (char-to-string org-default-priority))) + (char-to-string org-priority-default))) props) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "FILE")) @@ -13238,13 +12872,13 @@ unless LITERAL-NIL is non-nil." ;; 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. +(defun org--property-global-or-keyword-value (property literal-nil) + "Return value for PROPERTY as defined by global properties or by keyword. 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." +globally or by keyword. 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) + (cdr (or (assoc-string property org-keyword-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)))) @@ -13393,12 +13027,12 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead." value))) (cond ((car v) - (org-back-to-heading t) + (org-back-to-heading-or-point-min t) (move-marker org-entry-property-inherited-from (point)) (throw 'exit nil)) - ((org-up-heading-safe)) + ((org-up-heading-or-point-min)) (t - (let ((global (org--property-global-value property literal-nil))) + (let ((global (org--property-global-or-keyword-value property literal-nil))) (cond ((not global)) (value (setq value (concat global " " value))) (t (setq value global)))) @@ -13430,8 +13064,8 @@ decreases scheduled or deadline date by one day." (user-error "Invalid property name: \"%s\"" property))) (org-with-point-at pom (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))) + (org-back-to-heading-or-point-min t) + (org-with-limited-levels (org-back-to-heading-or-point-min t))) (let ((beg (point))) (cond ((equal property "TODO") @@ -13501,7 +13135,10 @@ COLUMN formats in the current buffer." (props (append (and specials org-special-properties) (and defaults (cons org-effort-property org-default-properties)) - nil))) + ;; Get property names from #+PROPERTY keywords as well + (mapcar (lambda (s) + (nth 0 (split-string s))) + (cdar (org-collect-keywords '("PROPERTY"))))))) (org-with-wide-buffer (goto-char (point-min)) (while (re-search-forward org-property-start-re nil t) @@ -13549,7 +13186,15 @@ COLUMN formats in the current buffer." (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)))))) + (sort (delete-dups + (append props + ;; for each xxx_ALL property, make sure the bare + ;; xxx property is also included + (delq nil (mapcar (lambda (p) + (and (string-match-p "._ALL\\'" p) + (substring p 0 -4))) + props)))) + (lambda (a b) (string< (upcase a) (upcase b)))))) (defun org-property-values (key) "List all non-nil values of property KEY in current buffer." @@ -13567,21 +13212,26 @@ COLUMN formats in the current buffer." Do nothing if the drawer already exists. The newly created drawer is immediately hidden." (org-with-wide-buffer + ;; Set point to the position where the drawer should be inserted. (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)) + (org-back-to-heading-or-point-min t) + (org-with-limited-levels (org-back-to-heading-or-point-min t))) + (if (org-before-first-heading-p) + (while (and (org-at-comment-p) (bolp)) (forward-line)) + (progn + (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))) + (when (and (bolp) (> (point) (point-min))) (backward-char)) + (let ((begin (if (bobp) (point) (1+ (point)))) (inhibit-read-only t)) - (insert "\n:PROPERTIES:\n:END:") - (org-flag-drawer t nil (line-end-position 0) (point)) - (when (eobp) (insert "\n")) + (unless (bobp) (insert "\n")) + (insert ":PROPERTIES:\n:END:") + (org-flag-region (line-end-position 0) (point) t 'outline) + (when (or (eobp) (= begin (point-min))) (insert "\n")) (org-indent-region begin (point)))))) (defun org-insert-drawer (&optional arg drawer) @@ -13761,7 +13411,8 @@ part of the buffer." (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))))))))) + (throw 'exit (progn (org-back-to-heading-or-point-min t) + (point))))))))) (defun org-delete-property (property) "In the current entry, delete PROPERTY." @@ -13831,8 +13482,8 @@ completion." (setq vals (org-with-point-at pom (append org-todo-keywords-1 '(""))))) ((equal property "PRIORITY") - (let ((n org-lowest-priority)) - (while (>= n org-highest-priority) + (let ((n org-priority-lowest)) + (while (>= n org-priority-highest) (push (char-to-string n) vals) (setq n (1- n))))) ((equal property "CATEGORY")) @@ -13897,15 +13548,9 @@ completion." (defun org-find-olp (path &optional this-buffer) "Return a marker pointing to the entry at outline path OLP. -If anything goes wrong, throw an error. -You can wrap this call to catch the error like this: - - (condition-case msg - (org-mobile-locate-entry (match-string 4)) - (error (nth 1 msg))) - -The return value will then be either a string with the error message, -or a marker if everything is OK. +If anything goes wrong, throw an error, and if you need to do +something based on this error, you can catch it with +`condition-case'. If THIS-BUFFER is set, the outline path does not contain a file, only headings." @@ -14081,16 +13726,16 @@ non-nil." (defun org-time-stamp-inactive (&optional arg) "Insert an inactive time stamp. -An inactive time stamp is enclosed in square brackets instead of angle -brackets. It is inactive in the sense that it does not trigger agenda entries, -does not link to the calendar and cannot be changed with the S-cursor keys. -So these are more for recording a certain time/date. +An inactive time stamp is enclosed in square brackets instead of +angle brackets. It is inactive in the sense that it does not +trigger agenda entries. So these are more for recording a +certain time/date. 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 included. -When called with two universal prefix arguments, insert an active time stamp +When called with two universal prefix arguments, insert an inactive time stamp with the current time without prompting the user." (interactive "P") (org-time-stamp arg 'inactive)) @@ -14106,7 +13751,6 @@ with the current time without prompting the user." (defvar org-overriding-default-time nil) ; dynamically scoped (defvar org-read-date-overlay nil) -(defvar org-dcst nil) ; dynamically scoped (defvar org-read-date-history nil) (defvar org-read-date-final-answer nil) (defvar org-read-date-analyze-futurep nil) @@ -14176,7 +13820,6 @@ user." (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)) @@ -14295,7 +13938,7 @@ user." " " (or org-ans1 org-ans2))) (org-end-time-was-given nil) (f (org-read-date-analyze ans org-def org-defdecode)) - (fmts (if org-dcst + (fmts (if org-display-custom-times org-time-stamp-custom-formats org-time-stamp-formats)) (fmt (if (or org-with-time @@ -14961,7 +14604,7 @@ signaled." (cdr errdata)))))))) (defun org-days-to-iso-week (days) - "Return the iso week number." + "Return the ISO week number." (require 'cal-iso) (car (calendar-iso-from-absolute days))) @@ -16041,7 +15684,7 @@ environment remains unintended." ;; Get indentation of next line unless at column 0. (let ((ind (if (bolp) 0 (save-excursion - (org-return-indent) + (org-return t) (prog1 (current-indentation) (when (progn (skip-chars-forward " \t") (eolp)) (delete-region beg (point))))))) @@ -16086,7 +15729,10 @@ looks only before point, not after." (catch 'exit (let ((pos (point)) (dodollar (member "$" (plist-get org-format-latex-options :matchers))) - (lim (save-excursion (org-backward-paragraph) (point))) + (lim (progn + (re-search-backward (concat "^\\(" paragraph-start "\\)") nil + 'move) + (point))) dd-on str (start 0) m re) (goto-char pos) (when dodollar @@ -16154,7 +15800,7 @@ BEG and END are buffer positions." ;; 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 + temporary-file-directory default-directory) 'overlays nil 'forbuffer org-preview-latex-default-process)))) @@ -16265,6 +15911,10 @@ Some of the options can be changed using the variable (if (string= (match-string 0 value) "$$") (insert "\\[" (substring value 2 -2) "\\]") (insert "\\(" (substring value 1 -1) "\\)")))) + ((eq processing-type 'html) + (goto-char beg) + (delete-region beg end) + (insert (org-format-latex-as-html value))) ((assq processing-type org-preview-latex-process-alist) ;; Process to an image. (cl-incf cnt) @@ -16393,7 +16043,7 @@ inspection." (write-region mathml nil mathml-file)) (when (called-interactively-p 'any) (message mathml))) - ((message "LaTeX to MathML conversion failed") + ((warn "LaTeX to MathML conversion failed") (message shell-command-output))) (delete-file tmp-in-file) (when (file-exists-p tmp-out-file) @@ -16430,6 +16080,14 @@ inspection." ;; Failed conversion. Return the LaTeX fragment verbatim latex-frag))) +(defun org-format-latex-as-html (latex-fragment) + "Convert LATEX-FRAGMENT to HTML. +This uses `org-latex-to-html-convert-command', which see." + (let ((cmd (format-spec org-latex-to-html-convert-command + `((?i . ,latex-fragment))))) + (message "Running %s" cmd) + (shell-command-to-string cmd))) + (defun org--get-display-dpi () "Get the DPI of the display. The function assumes that the display has the same pixel width in @@ -16499,12 +16157,16 @@ a HTML file." (setq bg (org-latex-color :background)) (setq bg (org-latex-color-format (if (string= bg "Transparent") "white" bg)))) + ;; Remove TeX \par at end of snippet to avoid trailing space. + (if (string-suffix-p string "\n") + (aset string (1- (length string)) ?%) + (setq string (concat string "%"))) (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" + "\\definecolor{fg}{rgb}{" fg "}%\n" + "\\definecolor{bg}{rgb}{" bg "}%\n" + "\n\\pagecolor{bg}%\n" "\n{\\color{fg}\n" string "\n}\n" @@ -16631,16 +16293,60 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." "No images to display inline"))))) (defun org-redisplay-inline-images () - "Refresh the display of inline images." + "Assure display of inline images and refresh them." (interactive) - (if (not org-inline-image-overlays) - (org-toggle-inline-images) - (org-toggle-inline-images) + (org-toggle-inline-images) + (unless org-inline-image-overlays (org-toggle-inline-images))) ;; For without-x builds. (declare-function image-refresh "image" (spec &optional frame)) +(defcustom org-display-remote-inline-images 'skip + "How to display remote inline images. +Possible values of this option are: + +skip Don't display remote images. +download Always download and display remote images. +cache Display remote images, and open them in separate buffers + for caching. Silently update the image buffer when a file + change is detected." + :group 'org-appearance + :package-version '(Org . "9.4") + :type '(choice + (const :tag "Ignore remote images" skip) + (const :tag "Always display remote images" download) + (const :tag "Display and silently update remote images" cache)) + :safe #'symbolp) + +(defun org--create-inline-image (file width) + "Create image located at FILE, or return nil. +WIDTH is the width of the image. The image may not be created +according to the value of `org-display-remote-inline-images'." + (let* ((remote? (file-remote-p file)) + (file-or-data + (pcase org-display-remote-inline-images + ((guard (not remote?)) file) + (`download (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally file) + (buffer-string))) + (`cache (let ((revert-without-query '("."))) + (with-current-buffer (find-file-noselect file) + (buffer-string)))) + (`skip nil) + (other + (message "Invalid value of `org-display-remote-inline-images': %S" + other) + nil)))) + (when file-or-data + (create-image file-or-data + (and (image-type-available-p 'imagemagick) + width + 'imagemagick) + remote? + :width width)))) + (defun org-display-inline-images (&optional include-linked refresh beg end) "Display inline images. @@ -16759,11 +16465,7 @@ buffer boundaries with possible narrowing." 'org-image-overlay))) (if (and (car-safe old) refresh) (image-refresh (overlay-get (cdr old) 'display)) - (let ((image (create-image file - (and (image-type-available-p 'imagemagick) - width 'imagemagick) - nil - :width width))) + (let ((image (org--create-inline-image file width))) (when image (let ((ov (make-overlay (org-element-property :begin link) @@ -16778,7 +16480,9 @@ buffer boundaries with possible narrowing." (overlay-put ov 'modification-hooks (list 'org-display-inline-remove-overlay)) - (overlay-put ov 'keymap image-map) + (when (<= 26 emacs-major-version) + (cl-assert (boundp 'image-map)) + (overlay-put ov 'keymap image-map)) (push ov org-inline-image-overlays)))))))))))))))) (defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) @@ -16865,7 +16569,7 @@ overwritten, and the table is not marked as requiring realignment." (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. + "Check if editing 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 (when (and org-catch-invisible-edits @@ -17025,7 +16729,7 @@ word constituents." (defvar org-ctrl-c-ctrl-c-hook nil "Hook for functions attaching themselves to `C-c C-c'. -This can be used to add additional functionality to the C-c C-c +This can be used to add additional functionality to the `C-c C-c' key which executes context-dependent commands. This hook is run before any other test, while `org-ctrl-c-ctrl-c-final-hook' is run after the last test. @@ -17038,7 +16742,7 @@ context is wrong, just do nothing and return nil.") (defvar org-ctrl-c-ctrl-c-final-hook nil "Hook for functions attaching themselves to `C-c C-c'. -This can be used to add additional functionality to the C-c C-c +This can be used to add additional functionality to the `C-c C-c' key which executes context-dependent commands. This hook is run after any other test, while `org-ctrl-c-ctrl-c-hook' is run before the first test. @@ -17403,13 +17107,15 @@ individual commands for more information." (call-interactively (if org-edit-timestamp-down-means-later 'org-timestamp-down 'org-timestamp-up))) ((and (not (eq org-support-shift-select 'always)) - org-enable-priority-commands + org-priority-enable-commands (org-at-heading-p)) (call-interactively 'org-priority-up)) ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-previous-item)) ((org-clocktable-try-shift 'up arg)) - ((org-at-table-p) (org-table-move-cell-up)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-table-p)) + (org-table-move-cell-up)) ((run-hook-with-args-until-success 'org-shiftup-final-hook)) (org-support-shift-select (org-call-for-shift-select 'previous-line)) @@ -17429,13 +17135,15 @@ individual commands for more information." (call-interactively (if org-edit-timestamp-down-means-later 'org-timestamp-up 'org-timestamp-down))) ((and (not (eq org-support-shift-select 'always)) - org-enable-priority-commands + org-priority-enable-commands (org-at-heading-p)) (call-interactively 'org-priority-down)) ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-next-item)) ((org-clocktable-try-shift 'down arg)) - ((org-at-table-p) (org-table-move-cell-down)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-table-p)) + (org-table-move-cell-down)) ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) (org-support-shift-select (org-call-for-shift-select 'next-line)) @@ -17473,7 +17181,9 @@ This does one of the following: (org-at-property-p)) (call-interactively 'org-property-next-allowed-value)) ((org-clocktable-try-shift 'right arg)) - ((org-at-table-p) (org-table-move-cell-right)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-table-p)) + (org-table-move-cell-right)) ((run-hook-with-args-until-success 'org-shiftright-final-hook)) (org-support-shift-select (org-call-for-shift-select 'forward-char)) @@ -17511,7 +17221,9 @@ This does one of the following: (org-at-property-p)) (call-interactively 'org-property-previous-allowed-value)) ((org-clocktable-try-shift 'left arg)) - ((org-at-table-p) (org-table-move-cell-left)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-table-p)) + (org-table-move-cell-left)) ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) (org-support-shift-select (org-call-for-shift-select 'backward-char)) @@ -17588,23 +17300,12 @@ this numeric value." (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." + "Call `org-table-hline-and-move' or `org-insert-heading'." (interactive) (cond ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) (t (call-interactively 'org-insert-heading)))) -(defun org-find-visible () - (let ((s (point))) - (while (and (not (= (point-max) (setq s (next-overlay-change s)))) - (get-char-property s 'invisible))) - s)) -(defun org-find-invisible () - (let ((s (point))) - (while (and (not (= (point-max) (setq s (next-overlay-change s)))) - (not (get-char-property s 'invisible)))) - s)) - (defun org-copy-visible (beg end) "Copy the visible parts of the region." (interactive "r") @@ -17712,6 +17413,7 @@ Otherwise, return a user error." (pcase (org-element-type context) (`footnote-reference (org-edit-footnote-reference)) (`inline-src-block (org-edit-inline-src-code)) + (`latex-fragment (org-edit-latex-fragment)) (`timestamp (if (eq 'inactive (org-element-property :type context)) (call-interactively #'org-time-stamp-inactive) (call-interactively #'org-time-stamp))) @@ -17723,14 +17425,19 @@ Otherwise, return a user error." This command does many different things, depending on context: +- If column view is active, in agenda or org buffers, quit it. + +- If there are highlights, remove them. + - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, this is what we do. - If the cursor is on a statistics cookie, update it. -- If the cursor is in a headline, prompt for tags and insert them - into the current line, aligned to `org-tags-column'. When called - with prefix arg, realign all tags in the current buffer. +- If the cursor is in a headline, in an agenda or an org buffer, + prompt for tags and insert them into the current line, aligned + to `org-tags-column'. When called with prefix arg, realign all + tags in the current buffer. - If the cursor is in one of the special #+KEYWORD lines, this triggers scanning the buffer for these lines and updating the @@ -17764,6 +17471,7 @@ This command does many different things, depending on context: inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") (cond + ((bound-and-true-p org-columns-overlays) (org-columns-quit)) ((or (bound-and-true-p org-clock-overlays) org-occur-highlights) (when (boundp 'org-clock-overlays) (org-clock-remove-overlays)) (org-remove-occur-highlights) @@ -17785,6 +17493,7 @@ This command does many different things, depending on context: src-block statistics-cookie table table-cell table-row timestamp) t)) + (radio-list-p (org-at-radio-list-p)) (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. @@ -17831,39 +17540,81 @@ This command does many different things, depending on context: ;; 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)))))) + (if (or radio-list-p + (and (boundp org-list-checkbox-radio-mode) + org-list-checkbox-radio-mode)) + (org-toggle-radio-button arg) + (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))))))) + (`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. + (if (or radio-list-p + (and (boundp org-list-checkbox-radio-mode) + org-list-checkbox-radio-mode)) + (org-toggle-radio-button arg) + (let* ((begin (org-element-property :contents-begin context)) + (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))) + (when (equal + (org-list-write-struct + struct (org-list-parents-alist struct) old-struct) + old-struct) + (message "Cannot update this checkbox")) + (org-update-checkbox-count-maybe)))) (`keyword (let ((org-inhibit-startup-visibility-stuff t) (org-startup-align-all-tables nil)) @@ -17872,40 +17623,6 @@ This command does many different things, depending on context: (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)) - (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))) - (when (equal - (org-list-write-struct - struct (org-list-parents-alist struct) old-struct) - old-struct) - (message "Cannot update this checkbox")) - (org-update-checkbox-count-maybe))) ((or `property-drawer `node-property) (call-interactively #'org-property-action)) (`radio-target @@ -17949,6 +17666,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))))))) (defun org-mode-restart () +"Restart `org-mode'." (interactive) (let ((indent-status (bound-and-true-p org-indent-mode))) (funcall major-mode) @@ -17980,13 +17698,17 @@ Move point to the beginning of first heading or end of buffer." (defun org-kill-note-or-show-branches () "Abort storing current note, or show just branches." (interactive) - (if org-finish-function - (let ((org-note-abort t)) - (funcall org-finish-function)) - (if (org-before-first-heading-p) - (org-show-branches-buffer) - (outline-hide-subtree) - (outline-show-branches)))) + (cond (org-finish-function + (let ((org-note-abort t)) (funcall org-finish-function))) + ((org-before-first-heading-p) + (org-show-branches-buffer) + (org-hide-archived-subtrees (point-min) (point-max))) + (t + (let ((beg (progn (org-back-to-heading) (point))) + (end (save-excursion (org-end-of-subtree t t) (point)))) + (outline-hide-subtree) + (outline-show-branches) + (org-hide-archived-subtrees beg end))))) (defun org-delete-indentation (&optional arg) "Join current line to previous and fix whitespace at join. @@ -17994,7 +17716,9 @@ Move point to the beginning of first heading or end of buffer." 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." +I.e. with a non-nil optional argument, join the line with the +following one. If there is a region then join the lines in that +region." (interactive "*P") (if (save-excursion (beginning-of-line (if arg 1 0)) @@ -18019,7 +17743,8 @@ With a non-nil optional argument, join it to the following one." ((not tags-column)) ;no tags (org-auto-align-tags (org-align-tags)) (t (org--align-tags-here tags-column)))) ;preserve tags column - (delete-indentation arg))) + (let ((current-prefix-arg arg)) + (call-interactively #'delete-indentation)))) (defun org-open-line (n) "Insert a new row in tables, call `open-line' elsewhere. @@ -18031,20 +17756,31 @@ call `open-line' on the very first character." (org-table-insert-row) (open-line n))) -(defun org-return (&optional indent) +(defun org--newline (indent arg interactive) + "Call `newline-and-indent' or just `newline'. +If INDENT is non-nil, call `newline-and-indent' with ARG to +indent unconditionally; otherwise, call `newline' with ARG and +INTERACTIVE, which can trigger indentation if +`electric-indent-mode' is enabled." + (if indent + (org-newline-and-indent arg) + (newline arg interactive))) + +(defun org-return (&optional indent arg interactive) "Goto next table row or insert a newline. Calls `org-table-next-row' or `newline', depending on context. When optional INDENT argument is non-nil, call -`newline-and-indent' instead of `newline'. +`newline-and-indent' with ARG, otherwise call `newline' with ARG +and INTERACTIVE. 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) + (interactive "i\nP\np") (let ((context (if org-return-follows-link (org-element-context) (org-element-at-point)))) (cond @@ -18095,45 +17831,47 @@ object (e.g., within a comment). In these case, you need to use (t (org--align-tags-here tags-column))) ;preserve tags column (end-of-line) (org-show-entry) - (if indent (newline-and-indent) (newline)) + (org--newline indent arg interactive) (when string (save-excursion (insert (org-trim string)))))) ;; In a list, make sure indenting keeps trailing text within. - ((and indent - (not (eolp)) + ((and (not (eolp)) (org-element-lineage context '(item))) (let ((trailing-data (delete-and-extract-region (point) (line-end-position)))) - (newline-and-indent) + (org--newline indent arg interactive) (save-excursion (insert trailing-data)))) (t ;; Do not auto-fill when point is in an Org property drawer. (let ((auto-fill-function (and (not (org-at-property-p)) auto-fill-function))) - (if indent - (newline-and-indent) - (newline))))))) + (org--newline indent arg interactive)))))) -(defun org-return-indent () - "Goto next table row or insert a newline and indent. -Calls `org-table-next-row' or `newline-and-indent', depending on -context. See the individual commands for more information." +(defun org-return-and-maybe-indent () + "Goto next table row, or insert a newline. +Call `org-table-next-row' or `org-return', depending on context. +See the individual commands for more information. + +When inserting a newline, indent the new line if +`electric-indent-mode' is disabled." (interactive) - (org-return t)) + (org-return (not electric-indent-mode))) (defun org-ctrl-c-tab (&optional arg) "Toggle columns width in a table, or show children. Call `org-table-toggle-column-width' if point is in a table. -Otherwise, call `org-show-children'. ARG is the level to hide." +Otherwise provide a compact view of the children. ARG is the +level to hide." (interactive "p") - (if (org-at-table-p) - (call-interactively #'org-table-toggle-column-width) - (if (org-before-first-heading-p) - (progn - (org-flag-above-first-heading) - (outline-hide-sublevels (or arg 1)) - (goto-char (point-min))) - (outline-hide-subtree) - (org-show-children arg)))) + (cond + ((org-at-table-p) + (call-interactively #'org-table-toggle-column-width)) + ((org-before-first-heading-p) + (save-excursion + (org-flag-above-first-heading) + (outline-hide-sublevels (or arg 1)))) + (t + (outline-hide-subtree) + (org-show-children arg)))) (defun org-ctrl-c-star () "Compute table, or change heading status of lines. @@ -18277,79 +18015,14 @@ an argument, unconditionally call `org-insert-heading'." (t #'org-insert-heading))))) ;;; Menu entries - (defsubst org-in-subtree-not-table-p () "Are we in a subtree and not in a table?" (and (not (org-before-first-heading-p)) (not (org-at-table-p)))) ;; 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)] - ["Next Field" org-cycle (org-at-table-p)] - ["Previous Field" org-shifttab (org-at-table-p)] - ["Next Row" org-return (org-at-table-p)] - "--" - ["Blank Field" org-table-blank-field (org-at-table-p)] - ["Edit Field" org-table-edit-field (org-at-table-p)] - ["Copy Field from Above" org-table-copy-down (org-at-table-p)] - "--" - ("Column" - ["Move Column Left" org-metaleft (org-at-table-p)] - ["Move Column Right" org-metaright (org-at-table-p)] - ["Delete Column" org-shiftmetaleft (org-at-table-p)] - ["Insert Column" org-shiftmetaright (org-at-table-p)] - ["Shrink Column" org-table-toggle-column-width (org-at-table-p)]) - ("Row" - ["Move Row Up" org-metaup (org-at-table-p)] - ["Move Row Down" org-metadown (org-at-table-p)] - ["Delete Row" org-shiftmetaup (org-at-table-p)] - ["Insert Row" org-shiftmetadown (org-at-table-p)] - ["Sort lines in region" org-table-sort-lines (org-at-table-p)] - "--" - ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) - ("Rectangle" - ["Copy Rectangle" org-copy-special (org-at-table-p)] - ["Cut Rectangle" org-cut-special (org-at-table-p)] - ["Paste Rectangle" org-paste-special (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) - "--" - ("Calculate" - ["Set Column Formula" org-table-eval-formula (org-at-table-p)] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-edit-special (org-at-table-p)] - "--" - ["Recalculate line" org-table-recalculate (org-at-table-p)] - ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] - "--" - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] - "--" - ["Sum Column/Rectangle" org-table-sum - (or (org-at-table-p) (org-region-active-p))] - ["Which Column?" org-table-current-column (org-at-table-p)]) - ["Debug Formulas" - org-table-toggle-formula-debugger - :style toggle :selected (bound-and-true-p org-table-formula-debug)] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays - :style toggle - :selected (bound-and-true-p org-table-overlay-coordinates)] - "--" - ["Create" org-table-create (not (org-at-table-p))] - ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] - ["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] - "--" - ("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" + `("Org" ("Show/Hide" ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] @@ -18369,8 +18042,6 @@ an argument, unconditionally call `org-insert-heading'." "--" ["Jump" org-goto t]) ("Edit Structure" - ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] - "--" ["Move Subtree Up" org-metaup (org-at-heading-p)] ["Move Subtree Down" org-metadown (org-at-heading-p)] "--" @@ -18393,6 +18064,7 @@ an argument, unconditionally call `org-insert-heading'." ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) ("Editing" ["Emphasis..." org-emphasize t] + ["Add block structure" org-insert-structure-template t] ["Edit Source Example" org-edit-special t] "--" ["Footnote new/jump" org-footnote-action t] @@ -18402,8 +18074,7 @@ an argument, unconditionally call `org-insert-heading'." "--" ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)] ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] - ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] - ) + ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]) "--" ("Hyperlinks" ["Store Link (Global)" org-store-link t] @@ -18520,13 +18191,6 @@ an argument, unconditionally call `org-insert-heading'." (org-inside-LaTeX-fragment-p)] ["Insert citation" org-reftex-citation t]) "--" - ("MobileOrg" - ["Push Files and Views" org-mobile-push t] - ["Get Captured and Flagged" org-mobile-pull t] - ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] - "--" - ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) - "--" ("Documentation" ["Show Version" org-version t] ["Info Documentation" org-info t] @@ -18534,8 +18198,7 @@ an argument, unconditionally call `org-insert-heading'." ("Customize" ["Browse Org Group" org-customize t] "--" - ["Expand This Menu" org-create-customize-menu - (fboundp 'customize-menu-create)]) + ["Expand This Menu" org-create-customize-menu t]) ["Send bug report" org-submit-bug-report t] "--" ("Refresh/Reload" @@ -18543,6 +18206,70 @@ an argument, unconditionally call `org-insert-heading'." ["Reload Org (after update)" org-reload t] ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"]))) +(easy-menu-define org-tbl-menu org-mode-map "Org Table menu" + '("Table" + ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] + ["Next Field" org-cycle (org-at-table-p)] + ["Previous Field" org-shifttab (org-at-table-p)] + ["Next Row" org-return (org-at-table-p)] + "--" + ["Blank Field" org-table-blank-field (org-at-table-p)] + ["Edit Field" org-table-edit-field (org-at-table-p)] + ["Copy Field from Above" org-table-copy-down (org-at-table-p)] + "--" + ("Column" + ["Move Column Left" org-metaleft (org-at-table-p)] + ["Move Column Right" org-metaright (org-at-table-p)] + ["Delete Column" org-shiftmetaleft (org-at-table-p)] + ["Insert Column" org-shiftmetaright (org-at-table-p)] + ["Shrink Column" org-table-toggle-column-width (org-at-table-p)]) + ("Row" + ["Move Row Up" org-metaup (org-at-table-p)] + ["Move Row Down" org-metadown (org-at-table-p)] + ["Delete Row" org-shiftmetaup (org-at-table-p)] + ["Insert Row" org-shiftmetadown (org-at-table-p)] + ["Sort lines in region" org-table-sort-lines (org-at-table-p)] + "--" + ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) + ("Rectangle" + ["Copy Rectangle" org-copy-special (org-at-table-p)] + ["Cut Rectangle" org-cut-special (org-at-table-p)] + ["Paste Rectangle" org-paste-special (org-at-table-p)] + ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) + "--" + ("Calculate" + ["Set Column Formula" org-table-eval-formula (org-at-table-p)] + ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] + ["Edit Formulas" org-edit-special (org-at-table-p)] + "--" + ["Recalculate line" org-table-recalculate (org-at-table-p)] + ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] + ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] + "--" + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] + "--" + ["Sum Column/Rectangle" org-table-sum + (or (org-at-table-p) (org-region-active-p))] + ["Which Column?" org-table-current-column (org-at-table-p)]) + ["Debug Formulas" + org-table-toggle-formula-debugger + :style toggle :selected (bound-and-true-p org-table-formula-debug)] + ["Show Col/Row Numbers" + org-table-toggle-coordinate-overlays + :style toggle + :selected (bound-and-true-p org-table-overlay-coordinates)] + "--" + ["Create" org-table-create (not (org-at-table-p))] + ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] + ["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] + "--" + ("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"]))) + (defun org-info (&optional node) "Read documentation for Org in the info system. With optional NODE, go directly to that node." @@ -18579,14 +18306,22 @@ information about your Org version and configuration." (erase-buffer) (insert "You are about to submit a bug report to the Org mailing list. -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. +If your report is about Org installation, please read this section: +https://orgmode.org/org.html#Installation -HOWEVER, some variables you have customized may contain private +Please read https://orgmode.org/org.html#Feedback on how to make +a good report, it will help Org contributors fixing your problem. + +Search https://lists.gnu.org/archive/html/emacs-orgmode/ to see +if the issue you are about to raise has already been dealt with. + +We also would like to add your full Org and Outline configuration +to the bug report. It will help us debugging the issue. + +*HOWEVER*, some variables you have customized may contain private information. The names of customers, colleagues, or friends, might -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 +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 configuration ") @@ -18616,6 +18351,7 @@ Your bug report will be posted to the Org mailing list. (defun org-install-agenda-files-menu () + "Install agenda file menu." (let ((bl (buffer-list))) (save-excursion (while bl @@ -18708,20 +18444,17 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (interactive) (org-load-modules-maybe) (org-require-autoloaded-modules) - (if (fboundp 'customize-menu-create) - (progn - (easy-menu-change - '("Org") "Customize" - `(["Browse Org group" org-customize t] - "--" - ,(customize-menu-create 'org) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t])) - (message "\"Org\"-menu now contains full customization menu")) - (error "Cannot expand menu (outdated version of cus-edit.el)"))) + (easy-menu-change + '("Org") "Customize" + `(["Browse Org group" org-customize t] + "--" + ,(customize-menu-create 'org) + ["Set" Custom-set t] + ["Save" Custom-save t] + ["Reset to Current" Custom-reset-current t] + ["Reset to Saved" Custom-reset-saved t] + ["Reset to Standard Settings" Custom-reset-standard t])) + (message "\"Org\"-menu now contains full customization menu")) ;;;; Miscellaneous stuff @@ -18851,7 +18584,8 @@ and :keyword." (when (memq 'org-formula faces) (push (list :table-special (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist))) + (next-single-property-change p 'face)) + clist))) ((org-at-table-p 'any) (push (list :table-table) clist))) (goto-char p) @@ -18864,14 +18598,16 @@ and :keyword." (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t)) (match-beginning 1)) (and (re-search-forward "[ \t]*#\\+END:?" nil t) - (match-end 0))) clist)) + (match-end 0))) + clist)) ((org-in-src-block-p) (push (list :src-block (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)))) + (match-beginning 0))) + clist)))) (goto-char p) ;; Now the small context @@ -18881,20 +18617,24 @@ and :keyword." ((memq 'org-link faces) (push (list :link (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist)) + (next-single-property-change p 'face)) + clist)) ((memq 'org-special-keyword faces) (push (list :keyword (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist)) + (next-single-property-change p 'face)) + clist)) ((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) + (overlay-start o) (overlay-end o)) + clist) (push (list :latex-preview - (overlay-start o) (overlay-end o)) clist)) + (overlay-start o) (overlay-end o)) + clist)) ((org-inside-LaTeX-fragment-p) ;; FIXME: positions wrong. (push (list :latex-fragment (point) (point)) clist))) @@ -19023,7 +18763,7 @@ earliest time on the cursor date that Org treats as that date (let (date day defd tp hod mod) (when with-time (setq tp (get-text-property (point) 'time)) - (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) + (when (and tp (string-match "\\([0-2]?[0-9]\\):\\([0-5][0-9]\\)" tp)) (setq hod (string-to-number (match-string 1 tp)) mod (string-to-number (match-string 2 tp)))) (or tp (let ((now (decode-time))) @@ -19081,6 +18821,11 @@ ELEMENT." (t (goto-char start) (current-indentation)))) + ((and + (eq org-adapt-indentation 'headline-data) + (memq type '(planning clock node-property property-drawer drawer))) + (org--get-expected-indentation + (org-element-property :parent element) t)) ((memq type '(headline inlinetask nil)) (if (org-match-line "[ \t]*$") (org--get-expected-indentation element t) @@ -19094,7 +18839,8 @@ ELEMENT." ;; At first line: indent according to previous sibling, if any, ;; ignoring footnote definitions and inline tasks, or parent's ;; contents. - ((= (line-beginning-position) start) + ((and ( = (line-beginning-position) start) + (eq org-adapt-indentation t)) (catch 'exit (while t (if (= (point-min) start) (throw 'exit 0) @@ -19119,7 +18865,7 @@ ELEMENT." (org--get-expected-indentation (org-element-property :parent previous) t)))))))))) ;; Otherwise, move to the first non-blank line above. - (t + ((not (eq org-adapt-indentation 'headline-data)) (beginning-of-line) (let ((pos (point))) (skip-chars-backward " \r\t\n") @@ -19161,7 +18907,9 @@ ELEMENT." (goto-char start) (current-indentation))) ;; In any other case, indent like the current line. - (t (current-indentation))))))))) + (t (current-indentation))))) + ;; Finally, no indentation is needed, fall back to 0. + (t (current-indentation)))))) (defun org--align-node-property () "Align node property at point. @@ -19219,31 +18967,28 @@ list structure. Instead, use \\`\\[org-shiftmetaleft]' or \ Also align node properties according to `org-property-format'." (interactive) - (cond - ((org-at-heading-p) 'noindent) - (t + (unless (org-at-heading-p) (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) + nil) ((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) + (< (point) + (org-with-point-at (org-element-property :end element) + (skip-chars-backward " \t\n") + (line-beginning-position 2)))) + nil) ((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-with-point-at (org-element-property :end element) + (skip-chars-backward " \t\n") + (line-beginning-position)))) (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))) (t (let ((column (org--get-expected-indentation element nil))) @@ -19255,7 +19000,7 @@ Also align node properties according to `org-property-format'." (when (eq type 'node-property) (let ((column (current-column))) (org--align-node-property) - (org-move-to-column column))))))))) + (org-move-to-column column)))))))) (defun org-indent-region (start end) "Indent each non-blank line in the region. @@ -19670,12 +19415,17 @@ filling the current element." (unwind-protect (progn (goto-char (region-end)) + (skip-chars-backward " \t\n") (while (> (point) start) - (org-backward-paragraph) - (org-fill-element justify))) + (org-fill-element justify) + (org-backward-paragraph))) (goto-char origin) (set-marker origin nil)))) - (t (org-fill-element justify))) + (t + (save-excursion + (when (org-match-line "[ \t]*$") + (skip-chars-forward " \t\n")) + (org-fill-element justify)))) ;; If we didn't change anything in the buffer (and the buffer was ;; previously unmodified), then flip the modification status back ;; to "unchanged". @@ -20377,7 +20127,8 @@ depending on context." (if (<= end (point)) ;on tags part (kill-region (point) (line-end-position)) (kill-region (point) end))) - (org-align-tags)) + ;; Only align tags when we are still on a heading: + (if (org-at-heading-p) (org-align-tags))) (t (kill-region (point) (line-end-position))))) (defun org-yank (&optional arg) @@ -20486,8 +20237,18 @@ interactive command with similar behavior." "Call `outline-back-to-heading', but provide a better error message." (condition-case nil (outline-back-to-heading invisible-ok) - (error (error "Before first headline at position %d in buffer %s" - (point) (current-buffer))))) + (error + (user-error "Before first headline at position %d in buffer %s" + (point) (current-buffer))))) + +(defun org-back-to-heading-or-point-min (&optional invisible-ok) + "Go back to heading or first point in buffer. +If point is before first heading go to first point in buffer +instead of back to heading." + (condition-case nil + (outline-back-to-heading invisible-ok) + (error + (goto-char (point-min))))) (defun org-before-first-heading-p () "Before first heading?" @@ -20515,12 +20276,31 @@ unless optional argument NO-INHERITANCE is non-nil." (t (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p)))))) +(defun org-in-archived-heading-p (&optional no-inheritance) + "Non-nil if point is under an archived 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 ((tags (org-get-tags nil 'local))) + (and tags + (cl-some (apply-partially #'string= org-archive-tag) tags)))) + (no-inheritance nil) + (t + (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p)))))) + (defun org-at-comment-p nil "Return t if cursor is in a commented line." (save-excursion (save-match-data (beginning-of-line) - (looking-at "^[ \t]*# ")))) + (looking-at org-comment-regexp)))) + +(defun org-at-keyword-p nil + "Return t if cursor is at a keyword-line." + (save-excursion + (move-beginning-of-line 1) + (looking-at org-keyword-regexp))) (defun org-at-drawer-p nil "Return t if cursor is at a drawer keyword." @@ -20569,6 +20349,17 @@ make a significant difference in outlines with very many siblings." (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t) (funcall outline-level))))) +(defun org-up-heading-or-point-min () + "Move to the heading line of which the present is a subheading, or point-min. +This version is needed to make point-min behave like a virtual +heading of level 0 for property-inheritance. It will return the +level of the headline found (down to 0) or nil if already at a +point before the first headline or at point-min." + (when (ignore-errors (org-back-to-heading t)) + (if (< 1 (funcall outline-level)) + (org-up-heading-safe) + (unless (= (point) (point-min)) (goto-char (point-min)))))) + (defun org-first-sibling-p () "Is this heading the first child of its parents?" (interactive) @@ -20669,28 +20460,31 @@ If there is no such heading, return nil." (defun org-end-of-subtree (&optional invisible-ok to-heading) "Goto to the end of a subtree." ;; This contains an exact copy of the original function, but it uses - ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-ok argument. + ;; `org-back-to-heading-or-point-min', to make it work also in invisible + ;; trees and before first headline. And is uses an invisible-ok argument. ;; Under Emacs this is not needed, but the old outline.el needs this fix. ;; Furthermore, when used inside Org, finding the end of a large subtree ;; with many children and grandchildren etc, this can be much faster ;; than the outline version. - (org-back-to-heading invisible-ok) + (org-back-to-heading-or-point-min invisible-ok) (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 - ;; 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. - (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) - (forward-char 1) - (and (re-search-forward re nil 'move) (beginning-of-line 1))) - ;; something else, do it the slow way - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading))) + (cond ((= level 0) + (goto-char (point-max))) + ((and (derived-mode-p 'org-mode) (< level 1000)) + ;; 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. + (let ((re (concat "^\\*\\{1," (number-to-string level) "\\} "))) + (forward-char 1) + (and (re-search-forward re nil 'move) (beginning-of-line 1)))) + (t + ;; something else, do it the slow way + (while (and (not (eobp)) + (or first (> (funcall outline-level) level))) + (setq first nil) + (outline-next-heading)))) (unless to-heading (when (memq (preceding-char) '(?\n ?\^M)) ;; Go to end of line before heading @@ -20702,26 +20496,50 @@ If there is no such heading, return nil." (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." + +When optional argument FULL is t, also skip planning information, +clocking lines and any kind of drawer. + +When FULL is non-nil but not t, skip planning information, +clocking lines and only non-regular drawers, i.e. properties and +logbook drawers." (org-back-to-heading t) (forward-line) + ;; Skip planning information. (when (looking-at-p org-planning-line-re) (forward-line)) + ;; Skip property drawer. (when (looking-at org-property-drawer-re) (goto-char (match-end 0)) (forward-line)) + ;; When FULL is not nil, skip more. (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)))))))) + (cond ;; Skip clock lines. + ((looking-at-p re) (forward-line)) + ;; Skip logbook drawer. + ((looking-at-p org-logbook-drawer-re) + (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) + (forward-line) + (throw 'exit t))) + ;; When FULL is t, skip regular drawer too. + ((and (eq full t) (looking-at-p org-drawer-regexp)) + (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) + (forward-line) + (throw 'exit t))) + (t (throw 'exit t)))))))) + +(defun org--line-fully-invisible-p () + "Return non-nil if the current line is fully invisible." + (let ((line-beg (line-beginning-position)) + (line-pos (1- (line-end-position))) + (is-invisible t)) + (while (and (< line-beg line-pos) is-invisible) + (setq is-invisible (org-invisible-p line-pos)) + (setq line-pos (1- line-pos))) + is-invisible)) (defun org-forward-heading-same-level (arg &optional invisible-ok) "Move forward to the ARG'th subheading at same level as this one. @@ -20744,8 +20562,14 @@ non-nil it will also look at invisible ones." (cond ((< l level) (setq count 0)) ((and (= l level) (or invisible-ok - (not (org-invisible-p - (line-beginning-position))))) + ;; FIXME: See commit a700fadd72 and the + ;; related discussion on why using + ;; `org--line-fully-invisible-p' is needed + ;; here, which is to serve the needs of an + ;; external package. If the change is + ;; wrong regarding Org itself, it should + ;; be removed. + (not (org--line-fully-invisible-p)))) (cl-decf count) (when (= l level) (setq result (point))))))) (goto-char result)) @@ -20758,175 +20582,332 @@ Stop at the first and last subheadings of a superior heading." (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'." + "Move to the next visible heading line. +With ARG, repeats or can move backward if negative." (interactive "p") - (org-with-limited-levels - (outline-next-visible-heading arg))) + (let ((regexp (concat "^" (org-get-limited-outline-regexp)))) + (if (< arg 0) + (beginning-of-line) + (end-of-line)) + (while (and (< arg 0) (re-search-backward regexp nil :move)) + (unless (bobp) + (while (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (goto-char (overlay-start o)) + (re-search-backward regexp nil :move)) + (_ nil)))) + (cl-incf arg)) + (while (and (> arg 0) (re-search-forward regexp nil t)) + (while (pcase (get-char-property-and-overlay (point) 'invisible) + (`(outline . ,o) + (goto-char (overlay-end o)) + (re-search-forward regexp nil :move)) + (_ + (end-of-line) + nil))) ;leave the loop + (cl-decf arg)) + (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) (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'." +With ARG, repeats or can move forward if negative." (interactive "p") - (org-with-limited-levels - (outline-previous-visible-heading arg))) + (org-next-visible-heading (- arg))) -(defun org-forward-paragraph () - "Move forward to beginning of next paragraph or equivalent. +(defun org-forward-paragraph (&optional arg) + "Move forward by a paragraph, or equivalent, unit. -The function moves point to the beginning of the next visible -structural element, which can be a paragraph, a table, a list -item, etc. It also provides some special moves for convenience: +With argument ARG, do it ARG times; +a negative argument ARG = -N means move backward N paragraphs. - - On an affiliated keyword, jump to the beginning of the - relative element. - - On an item or a footnote definition, move to the second - element inside, if any. - - On a table or a property drawer, jump after it. - - On a verse or source block, stop after blank lines." +The function moves point between two structural +elements (paragraphs, tables, lists, etc.). + +It also provides the following special moves for convenience: + + - on a table or a property drawer, move to its beginning; + - on comment, example, export, source and verse blocks, stop + at blank lines; + - skip consecutive clocks, diary S-exps, and keywords." + (interactive "^p") + (unless arg (setq arg 1)) + (if (< arg 0) (org-backward-paragraph (- arg)) + (while (and (> arg 0) (not (eobp))) + (org--forward-paragraph-once) + (cl-decf arg)) + ;; Return moves left. + arg)) + +(defun org-backward-paragraph (&optional arg) + "Move backward by a paragraph, or equivalent, unit. + +With argument ARG, do it ARG times; +a negative argument ARG = -N means move forward N paragraphs. + +The function moves point between two structural +elements (paragraphs, tables, lists, etc.). + +It also provides the following special moves for convenience: + + - on a table or a property drawer, move to its beginning; + - on comment, example, export, source and verse blocks, stop + at blank lines; + - skip consecutive clocks, diary S-exps, and keywords." + (interactive "^p") + (unless arg (setq arg 1)) + (if (< arg 0) (org-forward-paragraph (- arg)) + (while (and (> arg 0) (not (bobp))) + (org--backward-paragraph-once) + (cl-decf arg)) + ;; Return moves left. + arg)) + +(defun org--paragraph-at-point () + "Return paragraph, or equivalent, element at point. + +Paragraph element at point is the element at point, with the +following special cases: + +- treat table rows (resp. node properties) as the table + \(resp. property drawer) containing them. + +- treat plain lists with an item every line as a whole. + +- treat consecutive keywords, clocks, and diary-sexps as a single + block. + +Function may return a real element, or a pseudo-element with type +`pseudo-paragraph'." + (let* ((e (org-element-at-point)) + (type (org-element-type e)) + ;; If we need to fake a new pseudo-element, triplet is + ;; + ;; (BEG END PARENT) + ;; + ;; where BEG and END are element boundaries, and PARENT the + ;; element containing it, or nil. + (triplet + (cond + ((memq type '(table property-drawer)) + (list (org-element-property :begin e) + (org-element-property :end e) + (org-element-property :parent e))) + ((memq type '(node-property table-row)) + (let ((e (org-element-property :parent e))) + (list (org-element-property :begin e) + (org-element-property :end e) + (org-element-property :parent e)))) + ((memq type '(clock diary-sexp keyword)) + (let* ((regexp (pcase type + (`clock org-clock-line-re) + (`diary-sexp "%%(") + (_ org-keyword-regexp))) + (end (if (< 0 (org-element-property :post-blank e)) + (org-element-property :end e) + (org-with-wide-buffer + (forward-line) + (while (looking-at regexp) (forward-line)) + (skip-chars-forward " \t\n") + (line-beginning-position)))) + (begin (org-with-point-at (org-element-property :begin e) + (while (and (not (bobp)) (looking-at regexp)) + (forward-line -1)) + ;; We may have gotten one line too far. + (if (looking-at regexp) + (point) + (line-beginning-position 2))))) + (list begin end (org-element-property :parent e)))) + ;; Find the full plain list containing point, the check it + ;; contains exactly one line per item. + ((let ((l (org-element-lineage e '(plain-list) t))) + (while (memq (org-element-type (org-element-property :parent l)) + '(item plain-list)) + (setq l (org-element-property :parent l))) + (and l + (org-with-point-at (org-element-property :post-affiliated l) + (forward-line (length (org-element-property :structure l))) + (= (point) (org-element-property :contents-end l))) + ;; Return value. + (list (org-element-property :begin l) + (org-element-property :end l) + (org-element-property :parent l))))) + (t nil)))) ;no triplet: return element + (pcase triplet + (`(,b ,e ,p) + (org-element-create + 'pseudo-paragraph + (list :begin b :end e :parent p :post-blank 0 :post-affiliated b))) + (_ e)))) + +(defun org--forward-paragraph-once () + "Move forward to end of paragraph or equivalent, once. +See `org-forward-paragraph'." (interactive) - (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)))))) + (save-restriction + (widen) + (skip-chars-forward " \t\n") + (cond + ((eobp) nil) + ;; When inside a folded part, move out of it. + ((pcase (get-char-property-and-overlay (point) 'invisible) + (`(,(or `outline `org-hide-block) . ,o) + (goto-char (overlay-end o)) + (forward-line) + t) + (_ nil))) + (t + (let* ((element (org--paragraph-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (end (org-element-property :end element)) + (post-affiliated (org-element-property :post-affiliated element))) + (cond + ((eq type 'plain-list) + (forward-char) + (org--forward-paragraph-once)) + ;; If the element is folded, skip it altogether. + ((pcase (org-with-point-at post-affiliated + (get-char-property-and-overlay (line-end-position) + 'invisible)) + (`(,(or `outline `org-hide-block) . ,o) + (goto-char (overlay-end o)) + (forward-line) + t) + (_ nil))) + ;; At a greater element, move inside. + ((and contents-begin + (> contents-begin (point)) + (not (eq type 'paragraph))) + (goto-char contents-begin) + ;; Items and footnote definitions contents may not start at + ;; the beginning of the line. In this case, skip until the + ;; next paragraph. + (cond + ((not (bolp)) (org--forward-paragraph-once)) + ((org-previous-line-empty-p) (forward-line -1)) + (t nil))) + ;; Move between empty lines in some blocks. + ((memq type '(comment-block example-block export-block src-block + verse-block)) + (let ((contents-start + (org-with-point-at post-affiliated + (line-beginning-position 2)))) + (if (< (point) contents-start) + (goto-char contents-start) + (let ((contents-end + (org-with-point-at end + (skip-chars-backward " \t\n") + (line-beginning-position)))) + (cond + ((>= (point) contents-end) + (goto-char end) + (skip-chars-backward " \t\n") + (forward-line)) + ((re-search-forward "^[ \t]*\n" contents-end :move) + (forward-line -1)) + (t nil)))))) + (t + ;; Move to element's end. + (goto-char end) + (skip-chars-backward " \t\n") + (forward-line)))))))) -(defun org-backward-paragraph () - "Move backward to start of previous paragraph or equivalent. - -The function moves point to the beginning of the current -structural element, which can be a paragraph, a table, a list -item, etc., or to the beginning of the previous visible one if -point is already there. It also provides some special moves for -convenience: - - - On an affiliated keyword, jump to the first one. - - On a table or a property drawer, move to its beginning. - - On comment, example, export, src and verse blocks, stop - before blank lines." +(defun org--backward-paragraph-once () + "Move backward to start of paragraph or equivalent, once. +See `org-backward-paragraph'." (interactive) - (unless (bobp) - (let* ((deactivate-mark nil) - (element (org-element-at-point)) - (type (org-element-type element)) - (contents-end (org-element-property :contents-end element)) - (post-affiliated (org-element-property :post-affiliated element)) - (begin (org-element-property :begin element)) - (special? ;blocks handled specially - (memq type '(comment-block example-block export-block src-block - verse-block))) - (contents-begin - (if special? - ;; These types have no proper contents. Fake line - ;; below the block opening line as contents beginning. - (save-excursion (goto-char begin) (line-beginning-position 2)) - (org-element-property :contents-begin element)))) - (cond - ((not element) (goto-char (point-min))) - ((= (point) begin) - (backward-char) - (org-backward-paragraph)) - ((<= (point) post-affiliated) (goto-char begin)) - ;; Special behavior: on a table or a property drawer, move to - ;; its beginning. - ((memq type '(node-property table-row)) - (goto-char (org-element-property - :post-affiliated (org-element-property :parent element)))) - (special? - (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)))))) - ((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. - ((and contents-end (>= (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))))) + (save-restriction + (widen) + (cond + ((bobp) nil) + ;; Blank lines at the beginning of the buffer. + ((and (org-match-line "^[ \t]*$") + (save-excursion (skip-chars-backward " \t\n") (bobp))) + (goto-char (point-min))) + ;; When inside a folded part, move out of it. + ((pcase (get-char-property-and-overlay (1- (point)) 'invisible) + (`(,(or `outline `org-hide-block) . ,o) + (goto-char (1- (overlay-start o))) + (org--backward-paragraph-once) + t) + (_ nil))) + (t + (let* ((element (org--paragraph-at-point)) + (type (org-element-type element)) + (begin (org-element-property :begin element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-end (org-element-property :contents-end element)) + (end (org-element-property :end element)) + (parent (org-element-property :parent element)) + (reach + ;; Move to the visible empty line above position P, or + ;; to position P. Return t. + (lambda (p) + (goto-char p) + (when (and (org-previous-line-empty-p) + (let ((end (line-end-position 0))) + (or (= end (point-min)) + (not (org-invisible-p (1- end)))))) + (forward-line -1)) + t))) + (cond + ;; Already at the beginning of an element. + ((= begin (point)) + (cond + ;; There is a blank line above. Move there. + ((and (org-previous-line-empty-p) + (not (org-invisible-p (1- (line-end-position 0))))) + (forward-line -1)) + ;; At the beginning of the first element within a greater + ;; element. Move to the beginning of the greater element. + ((and parent (= begin (org-element-property :contents-begin parent))) + (funcall reach (org-element-property :begin parent))) + ;; Since we have to move anyway, find the beginning + ;; position of the element above. + (t + (forward-char -1) + (org--backward-paragraph-once)))) + ;; Skip paragraphs at the very beginning of footnote + ;; definitions or items. + ((and (eq type 'paragraph) + (org-with-point-at begin (not (bolp)))) + (funcall reach (progn (goto-char begin) (line-beginning-position)))) + ;; If the element is folded, skip it altogether. + ((org-with-point-at post-affiliated + (org-invisible-p (line-end-position) t)) + (funcall reach begin)) + ;; At the end of a greater element, move inside. + ((and contents-end + (<= contents-end (point)) + (not (eq type 'paragraph))) + (cond + ((memq type '(footnote-definition plain-list)) + (skip-chars-backward " \t\n") + (org--backward-paragraph-once)) + ((= contents-end (point)) + (forward-char -1) + (org--backward-paragraph-once)) + (t + (goto-char contents-end)))) + ;; Move between empty lines in some blocks. + ((and (memq type '(comment-block example-block export-block src-block + verse-block)) + (let ((contents-start + (org-with-point-at post-affiliated + (line-beginning-position 2)))) + (when (> (point) contents-start) + (let ((contents-end + (org-with-point-at end + (skip-chars-backward " \t\n") + (line-beginning-position)))) + (if (> (point) contents-end) + (progn (goto-char contents-end) t) + (skip-chars-backward " \t\n" begin) + (re-search-backward "^[ \t]*\n" contents-start :move) + t)))))) + ;; Move to element's start. + (t + (funcall reach begin)))))))) (defun org-forward-element () "Move forward by one element. @@ -21108,10 +21089,11 @@ ones already marked." (set-mark (save-excursion (goto-char (mark)) - (goto-char (org-element-property :end (org-element-at-point))))) + (goto-char (org-element-property :end (org-element-at-point))) + (point))) (let ((element (org-element-at-point))) (end-of-line) - (push-mark (org-element-property :end element) t t) + (push-mark (min (point-max) (org-element-property :end element)) t t) (goto-char (org-element-property :begin element)))))) (defun org-narrow-to-element () @@ -21231,4 +21213,8 @@ Started from `gnus-info-find-node'." (run-hooks 'org-load-hook) +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + ;;; org.el ends here diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index 972b58a9912..e5240f5c895 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -31,6 +31,8 @@ (require 'ox-publish) (require 'cl-lib) +;;; Function Declarations + (declare-function aa2u "ext:ascii-art-to-unicode" ()) ;;; Define Back-End @@ -954,7 +956,7 @@ channel." ((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) + ((org-export-custom-protocol-maybe link anchor 'ascii info) nil) (t (concat (org-ascii--fill-string @@ -1270,7 +1272,8 @@ CONTENTS is nil. INFO is a plist holding contextual information." (org-ascii--justify-element (org-ascii--box-string (org-remove-indentation - (org-element-property :value fixed-width)) info) + (org-element-property :value fixed-width)) + info) fixed-width info)) @@ -1569,7 +1572,7 @@ DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information." (let ((type (org-element-property :type link))) (cond - ((org-export-custom-protocol-maybe link desc 'ascii)) + ((org-export-custom-protocol-maybe link desc 'ascii info)) ((string= type "coderef") (let ((ref (org-element-property :path link))) (format (org-export-get-coderef-format ref desc) @@ -1605,13 +1608,11 @@ INFO is a plist holding contextual information." ;; Don't know what to do. Signal it. (_ "???")))) (t - (let ((raw-link (concat (org-element-property :type link) - ":" - (org-element-property :path link)))) - (if (not (org-string-nw-p desc)) (format "<%s>" raw-link) + (let ((path (org-element-property :raw-link link))) + (if (not (org-string-nw-p desc)) (format "<%s>" path) (concat (format "[%s]" desc) (and (not (plist-get info :ascii-links-to-notes)) - (format " (<%s>)" raw-link))))))))) + (format " (<%s>)" path))))))))) ;;;; Node Properties diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index 23656db444c..66589fac5d9 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -731,7 +731,7 @@ 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." - (or (org-export-custom-protocol-maybe link contents 'beamer) + (or (org-export-custom-protocol-maybe link contents 'beamer info) ;; 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))) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 678506a6756..d2f24f5c6e4 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -62,7 +62,6 @@ (export-block . org-html-export-block) (export-snippet . org-html-export-snippet) (fixed-width . org-html-fixed-width) - (footnote-definition . org-html-footnote-definition) (footnote-reference . org-html-footnote-reference) (headline . org-html-headline) (horizontal-rule . org-html-horizontal-rule) @@ -121,6 +120,7 @@ (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) (:html-link-up "HTML_LINK_UP" nil org-html-link-up) (:html-mathjax "HTML_MATHJAX" nil "" space) + (:html-equation-reference-format "HTML_EQUATION_REFERENCE_FORMAT" nil org-html-equation-reference-format t) (:html-postamble nil "html-postamble" org-html-postamble) (:html-preamble nil "html-preamble" org-html-preamble) (:html-head "HTML_HEAD" nil org-html-head newline) @@ -152,6 +152,7 @@ (: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-prefer-user-labels nil nil org-html-prefer-user-labels) (:html-self-link-headlines nil nil org-html-self-link-headlines) (:html-table-align-individual-fields nil nil org-html-table-align-individual-fields) @@ -232,50 +233,26 @@ property on the headline itself.") (defconst org-html-scripts "" "Basic JavaScript that is needed by HTML files produced by Org mode.") @@ -311,7 +288,7 @@ for the JavaScript code in this tag. } pre.src { position: relative; - overflow: visible; + overflow: auto; padding-top: 1.2em; } pre.src:before { @@ -532,73 +509,22 @@ means to use the maximum value consistent with other options." (defcustom org-html-infojs-template " " "The template for the export style additions when org-info.js is used. Option settings will replace the %MANAGER-OPTIONS cookie." :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "9.4") :type 'string) (defun org-html-infojs-install-script (exp-plist _backend) @@ -811,6 +737,24 @@ but without \"name\" attribute." :type 'boolean :safe #'booleanp) +(defcustom org-html-prefer-user-labels nil + "When non-nil use user-defined names and ID over internal ones. + +By default, Org generates its own internal ID values during HTML +export. This process ensures that these values are unique and +valid, but the keys are not available in advance of the export +process, and not so readable. + +When this variable is non-nil, Org will use NAME keyword, or the +real name of the target to create the ID attribute. + +Independently of this variable, however, CUSTOM_ID are always +used as a reference." + :group 'org-export-html + :package-version '(Org . "9.4") + :type 'boolean + :safe #'booleanp) + ;;;; Inlinetasks (defcustom org-html-format-inlinetask-function @@ -834,6 +778,24 @@ The function should return the string to be exported." ;;;; LaTeX +(defcustom org-html-equation-reference-format "\\eqref{%s}" + "The MathJax command to use when referencing equations. + +This is a format control string that expects a single string argument +specifying the label that is being referenced. The argument is +generated automatically on export. + +The default is to wrap equations in parentheses (using \"\\eqref{%s}\)\". + +Most common values are: + + \\eqref{%s} Wrap the equation in parentheses + \\ref{%s} Do not wrap the equation in parentheses" + :group 'org-export-html + :package-version '(Org . "9.4") + :type 'string + :safe t) + (defcustom org-html-with-latex org-export-with-latex "Non-nil means process LaTeX math snippets. @@ -847,6 +809,8 @@ e.g. \"tex:mathjax\". Allowed values are: `verbatim' Keep everything in verbatim `mathjax', t Do MathJax preprocessing and arrange for MathJax.js to be loaded. + `html' Use `org-latex-to-html-convert-command' to convert + LaTeX fragments to HTML. SYMBOL Any symbol defined in `org-preview-latex-process-alist', e.g., `dvipng'." :group 'org-export-html @@ -884,10 +848,9 @@ link to the image." :type 'boolean) (defcustom org-html-inline-image-rules - '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("attachment" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) + `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))) + ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))) + ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))) "Rules characterizing image files that can be inlined into HTML. A rule consists in an association whose key is the type of link to consider, and value is a regexp that will be matched against @@ -1350,9 +1313,10 @@ like that: \"%%\"." (string :tag "Format string")))) (defcustom org-html-validation-link - "Validate" + "Validate" "Link to HTML validation service." :group 'org-export-html + :package-version '(Org . "9.4") :type 'string) (defcustom org-html-creator-string @@ -1662,6 +1626,36 @@ attribute with a nil value will be omitted from the result." "\"" """ (org-html-encode-plain-text item)))) (setcar output (format "%s=\"%s\"" key value)))))))) +(defun org-html--reference (datum info &optional named-only) + "Return an appropriate reference for DATUM. + +DATUM is an element or a `target' type object. INFO is the +current export state, as a plist. + +When NAMED-ONLY is non-nil and DATUM has no NAME keyword, return +nil. This doesn't apply to headlines, inline tasks, radio +targets and targets." + (let* ((type (org-element-type datum)) + (user-label + (org-element-property + (pcase type + ((or `headline `inlinetask) :CUSTOM_ID) + ((or `radio-target `target) :value) + (_ :name)) + datum))) + (cond + ((and user-label + (or (plist-get info :html-prefer-user-labels) + ;; Used CUSTOM_ID property unconditionally. + (memq type '(headline inlinetask)))) + user-label) + ((and named-only + (not (memq type '(headline inlinetask radio-target target))) + (not user-label)) + nil) + (t + (org-export-get-reference datum info))))) + (defun org-html--wrap-image (contents info &optional caption label) "Wrap CONTENTS string within an appropriate environment for images. INFO is a plist used as a communication channel. When optional @@ -1693,7 +1687,8 @@ a communication channel." (org-html--make-attribute-string (org-combine-plists (list :src source - :alt (if (string-match-p "^ltxpng/" source) + :alt (if (string-match-p + (concat "^" org-preview-latex-image-directory) source) (org-html-encode-plain-text (org-find-text-property-in-string 'org-latex-src source)) (file-name-nondirectory source))) @@ -1853,13 +1848,8 @@ INFO is a plist used as a communication channel." (title (if (org-string-nw-p title) title "‎")) (author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) - (and auth - ;; Return raw Org syntax, skipping non - ;; exportable objects. - (org-element-interpret-data - (org-element-map auth - (cons 'plain-text org-element-all-objects) - 'identity info)))))) + ;; Return raw Org syntax. + (and auth (org-element-interpret-data auth))))) (description (plist-get info :description)) (keywords (plist-get info :keywords)) (charset (or (and org-html-coding-system @@ -1882,7 +1872,7 @@ INFO is a plist used as a communication channel." charset) "\n" (let ((viewport-options (cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell))) - (plist-get info :html-viewport)))) + (plist-get info :html-viewport)))) (and viewport-options (concat (org-html-close-tag @@ -2213,7 +2203,8 @@ is the language used for CODE, as a string, or nil." ;; htmlize (setq code (let ((output-type org-html-htmlize-output-type) - (font-prefix org-html-htmlize-font-prefix)) + (font-prefix org-html-htmlize-font-prefix) + (inhibit-read-only t)) (with-temp-buffer ;; Switch to language-specific mode. (funcall lang-mode) @@ -2372,8 +2363,7 @@ INFO is a plist used as a communication channel." (org-export-get-tags headline info)))) (format "%s" ;; Label. - (or (org-element-property :CUSTOM_ID headline) - (org-export-get-reference headline info)) + (org-html--reference headline info) ;; Body. (concat (and (not (org-export-low-level-p headline info)) @@ -2401,8 +2391,7 @@ of listings as a string, or nil if it is empty." (org-html--translate "Listing %d:" info)))) (mapconcat (lambda (entry) - (let ((label (and (org-element-property :name entry) - (org-export-get-reference entry info))) + (let ((label (org-html--reference entry info t)) (title (org-trim (org-export-data (or (org-export-get-caption entry t) @@ -2440,8 +2429,7 @@ of tables as a string, or nil if it is empty." (org-html--translate "Table %d:" info)))) (mapconcat (lambda (entry) - (let ((label (and (org-element-property :name entry) - (org-export-get-reference entry info))) + (let ((label (org-html--reference entry info t)) (title (org-trim (org-export-data (or (org-export-get-caption entry t) @@ -2542,11 +2530,11 @@ information." (if (plist-get attributes :textarea) (org-html--textarea-block example-block) (format "
\n%s
" - (let* ((name (org-element-property :name example-block)) + (let* ((reference (org-html--reference example-block info)) (a (org-html--make-attribute-string - (if (or (not name) (plist-member attributes :id)) + (if (or (not reference) (plist-member attributes :id)) attributes - (plist-put attributes :id name))))) + (plist-put attributes :id reference))))) (if (org-string-nw-p a) (concat " " a) "")) (org-html-format-code example-block info))))) @@ -2622,8 +2610,7 @@ holding contextual information." (full-text (funcall (plist-get info :html-format-headline-function) todo todo-type priority text tags info)) (contents (or contents "")) - (id (or (org-element-property :CUSTOM_ID headline) - (org-export-get-reference headline info))) + (id (org-html--reference headline info)) (formatted-text (if (plist-get info :html-self-link-headlines) (format "%s" id full-text) @@ -2649,8 +2636,7 @@ holding contextual information." (first-content (car (org-element-contents headline)))) (format "<%s id=\"%s\" class=\"%s\">%s%s\n" (org-html--container headline info) - (concat "outline-container-" - (org-export-get-reference headline info)) + (format "outline-container-%s" id) (concat (format "outline-%d" level) (and extra-class " ") extra-class) @@ -2711,8 +2697,7 @@ contextual information." (org-element-property :value inline-src-block) lang)) (label - (let ((lbl (and (org-element-property :name inline-src-block) - (org-export-get-reference inline-src-block info)))) + (let ((lbl (org-html--reference inline-src-block info t))) (if (not lbl) "" (format " id=\"%s\"" lbl))))) (format "%s" lang label code))) @@ -2848,12 +2833,13 @@ 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 can -be `mathjax', `verbatim', nil, t or symbols in +be `mathjax', `verbatim', `html', 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) + (unless (or (eq processing-type 'mathjax) + (eq processing-type 'html)) (let ((bfn (or (buffer-file-name) (make-temp-name (expand-file-name "latex" temporary-file-directory)))) @@ -2903,6 +2889,12 @@ used as a predicate for `org-export-get-ordinal' or a value to (string-match-p org-latex-math-environments-re (org-element-property :value element))) +(defun org-html--latex-environment-numbered-p (element) + "Non-nil when ELEMENT contains a numbered LaTeX math environment. +Starred and \"displaymath\" environments are not numbered." + (not (string-match-p "\\`[ \t]*\\\\begin{\\(.*\\*\\|displaymath\\)}" + (org-element-property :value element)))) + (defun org-html--unlabel-latex-environment (latex-frag) "Change environment in LATEX-FRAG string to an unnumbered one. For instance, change an 'equation' environment to 'equation*'." @@ -2921,12 +2913,14 @@ CONTENTS is nil. INFO is a plist holding contextual information." (latex-frag (org-remove-indentation (org-element-property :value latex-environment))) (attributes (org-export-read-attribute :attr_html latex-environment)) - (label (and (org-element-property :name latex-environment) - (org-export-get-reference latex-environment info))) - (caption (number-to-string - (org-export-get-ordinal - latex-environment info nil - #'org-html--math-environment-p)))) + (label (org-html--reference latex-environment info t)) + (caption (and (org-html--latex-environment-numbered-p latex-environment) + (number-to-string + (org-export-get-ordinal + latex-environment info nil + (lambda (l _) + (and (org-html--math-environment-p l) + (org-html--latex-environment-numbered-p l)))))))) (cond ((memq processing-type '(t mathjax)) (org-html-format-latex @@ -2942,10 +2936,10 @@ CONTENTS is nil. INFO is a plist holding contextual information." (org-html--unlabel-latex-environment latex-frag) processing-type info))) (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) - (org-html--wrap-latex-environment - (org-html--format-image - (match-string 1 formula-link) attributes info) - info caption label)))) + (let ((source (org-export-file-uri (match-string 1 formula-link)))) + (org-html--wrap-latex-environment + (org-html--format-image source attributes info) + info caption label))))) (t (org-html--wrap-latex-environment latex-frag info caption label))))) ;;;; Latex Fragment @@ -2958,11 +2952,14 @@ CONTENTS is nil. INFO is a plist holding contextual information." (cond ((memq processing-type '(t mathjax)) (org-html-format-latex latex-frag 'mathjax info)) + ((memq processing-type '(t html)) + (org-html-format-latex latex-frag 'html 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)))) + (let ((source (org-export-file-uri (match-string 1 formula-link)))) + (org-html--format-image source nil info))))) (t latex-frag)))) ;;;; Line Break @@ -3044,7 +3041,9 @@ images, set it to: DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information. See `org-export-data'." - (let* ((link-org-files-as-html-maybe + (let* ((html-ext (plist-get info :html-extension)) + (dot (when (> (length html-ext) 0) ".")) + (link-org-files-as-html-maybe (lambda (raw-path info) ;; Treat links to `file.org' as links to `file.html', if ;; needed. See `org-html-link-org-files-as-html'. @@ -3052,8 +3051,7 @@ INFO is a plist holding contextual information. See ((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))) + (concat (file-name-sans-extension raw-path) dot html-ext)) (t raw-path)))) (type (org-element-property :type link)) (raw-path (org-element-property :path link)) @@ -3063,7 +3061,7 @@ INFO is a plist holding contextual information. See (cond ((member type '("http" "https" "ftp" "mailto" "news")) (url-encode-url (concat type ":" raw-path))) - ((string= type "file") + ((string= "file" type) ;; During publishing, turn absolute file names belonging ;; to base directory into relative file names. Otherwise, ;; append "file" protocol to absolute file name. @@ -3114,7 +3112,7 @@ INFO is a plist holding contextual information. See (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)) + ((org-export-custom-protocol-maybe link desc 'html info)) ;; Image file. ((and (plist-get info :html-inline-images) (org-export-inline-image-p @@ -3152,8 +3150,7 @@ INFO is a plist holding contextual information. See (org-element-property :raw-link link) info)))) ;; Link points to a headline. (`headline - (let ((href (or (org-element-property :CUSTOM_ID destination) - (org-export-get-reference destination info))) + (let ((href (org-html--reference destination info)) ;; What description to use? (desc ;; Case 1: Headline is numbered and LINK has no @@ -3177,11 +3174,11 @@ INFO is a plist holding contextual information. See (eq 'latex-environment (org-element-type destination)) (eq 'math (org-latex--environment-type destination))) ;; Caption and labels are introduced within LaTeX - ;; environment. Use "eqref" macro to refer to those in - ;; the document. - (format "\\eqref{%s}" - (org-export-get-reference destination info)) - (let* ((ref (org-export-get-reference destination info)) + ;; environment. Use "ref" or "eqref" macro, depending on user + ;; preference to refer to those in the document. + (format (plist-get info :html-equation-reference-format) + (org-html--reference destination info)) + (let* ((ref (org-html--reference destination info)) (org-html-standalone-image-predicate #'org-html--has-caption-p) (counter-predicate @@ -3278,8 +3275,7 @@ the plist used as a communication channel." info nil #'org-html-standalone-image-p)) " " raw)))) - (label (and (org-element-property :name paragraph) - (org-export-get-reference paragraph info)))) + (label (org-html--reference paragraph info))) (org-html--wrap-image contents info caption label))) ;; Regular paragraph. (t (format "\n%s

" @@ -3385,17 +3381,17 @@ holding contextual information." ;;;; 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" - (let* ((name (org-element-property :name quote-block)) + (let* ((reference (org-html--reference quote-block info t)) (attributes (org-export-read-attribute :attr_html quote-block)) (a (org-html--make-attribute-string - (if (or (not name) (plist-member attributes :id)) + (if (or (not reference) (plist-member attributes :id)) attributes - (plist-put attributes :id name))))) + (plist-put attributes :id reference))))) (if (org-string-nw-p a) (concat " " a) "")) contents)) @@ -3430,7 +3426,7 @@ 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 ((ref (org-export-get-reference radio-target info))) + (let ((ref (org-html--reference radio-target info))) (org-html--anchor ref text nil info))) ;;;; Special Block @@ -3449,11 +3445,11 @@ holding contextual information." (if class (concat class " " block-type) block-type))))) (let* ((contents (or contents "")) - (name (org-element-property :name special-block)) + (reference (org-html--reference special-block info)) (a (org-html--make-attribute-string - (if (or (not name) (plist-member attributes :id)) + (if (or (not reference) (plist-member attributes :id)) attributes - (plist-put attributes :id name)))) + (plist-put attributes :id reference)))) (str (if (org-string-nw-p a) (concat " " a) ""))) (if html5-fancy (format "<%s%s>\n%s" block-type str contents block-type) @@ -3469,8 +3465,7 @@ contextual information." (org-html--textarea-block 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)))) + (label (let ((lbl (org-html--reference src-block info t))) (if lbl (format " id=\"%s\"" lbl) ""))) (klipsify (and (plist-get info :html-klipsify-src) (member lang '("javascript" "js" @@ -3665,8 +3660,7 @@ contextual information." (attributes (org-html--make-attribute-string (org-combine-plists - (and (org-element-property :name table) - (list :id (org-export-get-reference table info))) + (list :id (org-html--reference table info t)) (and (not (org-html-html5-p info)) (plist-get info :html-table-attributes)) (org-export-read-attribute :attr_html table)))) @@ -3713,7 +3707,7 @@ contextual information." "Transcode a TARGET object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((ref (org-export-get-reference target info))) + (let ((ref (org-html--reference target info))) (org-html--anchor ref nil nil info))) ;;;; Timestamp @@ -3852,9 +3846,11 @@ file-local settings. Return output file's name." (interactive) - (let* ((extension (concat "." (or (plist-get ext-plist :html-extension) - org-html-extension - "html"))) + (let* ((extension (concat + (when (> (length org-html-extension) 0) ".") + (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 @@ -3870,9 +3866,10 @@ publishing directory. Return output file name." (org-publish-org-to 'html filename - (concat "." (or (plist-get plist :html-extension) - org-html-extension - "html")) + (concat (when (> (length org-html-extension) 0) ".") + (or (plist-get plist :html-extension) + org-html-extension + "html")) plist pub-dir)) diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index 5968d4ee649..0f890534a8a 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -367,7 +367,8 @@ A headline is blocked when either (defun org-icalendar-use-UTC-date-time-p () "Non-nil when `org-icalendar-date-time-format' requires UTC time." (char-equal (elt org-icalendar-date-time-format - (1- (length org-icalendar-date-time-format))) ?Z)) + (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 tz) @@ -763,10 +764,10 @@ Return VTODO component as a string." "SEQUENCE:1\n" (format "PRIORITY:%d\n" (let ((pri (or (org-element-property :priority entry) - org-default-priority))) - (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority - org-highest-priority))))))) + org-priority-default))) + (floor (- 9 (* 8. (/ (float (- org-priority-lowest pri)) + (- org-priority-lowest + org-priority-highest))))))) (format "STATUS:%s\n" (if (eq (org-element-property :todo-type entry) 'todo) "NEEDS-ACTION" diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index edb3150796f..32d1d43a5f3 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -30,6 +30,8 @@ (require 'ox) (require 'ox-publish) +;;; Function Declarations + (defvar org-latex-default-packages-alist) (defvar org-latex-packages-alist) (defvar orgtbl-exp-regexp) @@ -736,8 +738,9 @@ environment." :safe #'stringp) (defcustom org-latex-inline-image-rules - `(("file" . ,(regexp-opt - '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")))) + `(("file" . ,(rx "." + (or "pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg") + eos))) "Rules characterizing image files that can be inlined into LaTeX. A rule consists in an association whose key is the type of link @@ -750,8 +753,7 @@ pdflatex, pdf, jpg and png images are OK. When processing through dvi to Postscript, only ps and eps are allowed. The default we use here encompasses both." :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "9.4") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -1239,7 +1241,7 @@ calling `org-latex-compile'." :package-version '(Org . "8.3") :type '(repeat (cons - (string :tag "Regexp") + (regexp :tag "Regexp") (string :tag "Message")))) @@ -1586,6 +1588,7 @@ INFO is a plist used as a communication channel." lang)))) `((?a . ,(org-export-data (plist-get info :author) info)) (?t . ,(org-export-data (plist-get info :title) info)) + (?s . ,(org-export-data (plist-get info :subtitle) info)) (?k . ,(org-export-data (org-latex--wrap-latex-math-block (plist-get info :keywords) info) info)) @@ -2171,25 +2174,27 @@ contextual information." "Transcode an ITEM element from Org to LaTeX. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((counter - (let ((count (org-element-property :counter item)) - (level - ;; Determine level of current item to determine the - ;; correct LaTeX counter to use (enumi, enumii...). - (let ((parent item) (level 0)) - (while (memq (org-element-type - (setq parent (org-export-get-parent parent))) - '(plain-list item)) - (when (and (eq (org-element-type parent) 'plain-list) - (eq (org-element-property :type parent) - 'ordered)) - (cl-incf level))) - level))) - (and count - (< level 5) - (format "\\setcounter{enum%s}{%s}\n" - (nth (1- level) '("i" "ii" "iii" "iv")) - (1- count))))) + (let* ((orderedp (eq (org-element-property + :type (org-export-get-parent item)) + 'ordered)) + (level + ;; Determine level of current item to determine the + ;; correct LaTeX counter to use (enumi, enumii...). + (let ((parent item) (level 0)) + (while (memq (org-element-type + (setq parent (org-export-get-parent parent))) + '(plain-list item)) + (when (and (eq (org-element-type parent) 'plain-list) + (eq (org-element-property :type parent) + 'ordered)) + (cl-incf level))) + level)) + (count (org-element-property :counter item)) + (counter (and count + (< level 5) + (format "\\setcounter{enum%s}{%s}\n" + (nth (1- level) '("i" "ii" "iii" "iv")) + (1- count)))) (checkbox (cl-case (org-element-property :checkbox item) (on "$\\boxtimes$") (off "$\\square$") @@ -2208,9 +2213,11 @@ contextual information." "\\item" (cond ((and checkbox tag) - (format "[{%s %s}] %s" checkbox tag tag-footnotes)) + (format (if orderedp "{%s %s} %s" "[{%s %s}] %s") + checkbox tag tag-footnotes)) ((or checkbox tag) - (format "[{%s}] %s" (or checkbox tag) tag-footnotes)) + (format (if orderedp "{%s} %s" "[{%s}] %s") + (or checkbox tag) tag-footnotes)) ;; Without a tag or a check-box, if CONTENTS starts with ;; an opening square bracket, add "\relax" to "\item", ;; unless the brackets comes from an initial export @@ -2382,8 +2389,11 @@ used as a communication channel." (format "[%s]" (plist-get info :latex-default-figure-position))) (t "")))) (center - (if (plist-member attr :center) (plist-get attr :center) - (plist-get info :latex-images-centered))) + (cond + ;; If link is an image link, do not center. + ((eq 'link (org-element-type (org-export-get-parent link))) nil) + ((plist-member attr :center) (plist-get attr :center)) + (t (plist-get info :latex-images-centered)))) (comment-include (if (plist-get attr :comment-include) "%" "")) ;; It is possible to specify scale or width and height in ;; the ATTR_LATEX line, and also via default variables. @@ -2425,7 +2435,8 @@ used as a communication channel." (format "\\resizebox{%s}{%s}{%s}" (if (org-string-nw-p width) width "!") (if (org-string-nw-p height) height "!") - image-code))))) + image-code)) + (t image-code)))) ;; For other images: ;; - add scale, or width and height to options. ;; - include the image with \includegraphics. @@ -2517,15 +2528,16 @@ INFO is a plist holding contextual information. See (imagep (org-export-inline-image-p link (plist-get info :latex-inline-image-rules))) (path (org-latex--protect-text - (cond ((member type '("http" "https" "ftp" "mailto" "doi")) - (concat type ":" raw-path)) - ((string= type "file") - (org-export-file-uri raw-path)) - (t - raw-path))))) + (pcase type + ((or "http" "https" "ftp" "mailto" "doi") + (concat type ":" raw-path)) + ("file" + (org-export-file-uri raw-path)) + (_ + raw-path))))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'latex)) + ((org-export-custom-protocol-maybe link desc 'latex info)) ;; Image file. (imagep (org-latex--inline-image link info)) ;; Radio link: Transcode target's contents and use them as link's @@ -2576,7 +2588,9 @@ INFO is a plist holding contextual information. See ;; equivalent line number. ((string= type "coderef") (format (org-export-get-coderef-format path desc) - (org-export-resolve-coderef path info))) + ;; Resolve with RAW-PATH since PATH could be tainted + ;; with `org-latex--protect-text' call above. + (org-export-resolve-coderef raw-path info))) ;; External link with a description part. ((and path desc) (format "\\href{%s}{%s}" path desc)) ;; External link without a description part. diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el index 36822ff9664..0e487d8966c 100644 --- a/lisp/org/ox-man.el +++ b/lisp/org/ox-man.el @@ -40,6 +40,8 @@ (require 'cl-lib) (require 'ox) +;;; Function Declarations + (defvar org-export-man-default-packages-alist) (defvar org-export-man-packages-alist) (defvar orgtbl-exp-regexp) @@ -599,24 +601,24 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Link -(defun org-man-link (link desc _info) +(defun org-man-link (link desc info) "Transcode a LINK object from Org to Man. DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information. See `org-export-data'." (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) + (raw-path (org-element-property :path link)) ;; Ensure DESC really exists, or set it to nil. (desc (and (not (string= desc "")) desc)) - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") (org-export-file-uri raw-path)) - (t raw-path)))) + (path (pcase type + ((or "http" "https" "ftp" "mailto") + (concat type ":" raw-path)) + ("file" (org-export-file-uri raw-path)) + (_ raw-path)))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'man)) + ((org-export-custom-protocol-maybe link desc 'man info)) ;; External link with a description part. ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) ;; External link without a description part. @@ -1136,8 +1138,4 @@ Return PDF file name or an error if it couldn't be produced." (provide 'ox-man) -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - ;;; ox-man.el ends here diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index 91d5c0ba089..1d20c04f44d 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -85,13 +85,17 @@ The %s will be replaced by the footnote reference itself." (if a (org-md-export-to-markdown t s v) (org-open-file (org-md-export-to-markdown nil s v))))))) :translate-alist '((bold . org-md-bold) + (center-block . org-md--convert-to-html) (code . org-md-verbatim) + (drawer . org-md--identity) + (dynamic-block . org-md--identity) (example-block . org-md-example-block) (export-block . org-md-export-block) (fixed-width . org-md-example-block) (headline . org-md-headline) (horizontal-rule . org-md-horizontal-rule) (inline-src-block . org-md-verbatim) + (inlinetask . org-md--convert-to-html) (inner-template . org-md-inner-template) (italic . org-md-italic) (item . org-md-item) @@ -105,7 +109,9 @@ The %s will be replaced by the footnote reference itself." (property-drawer . org-md-property-drawer) (quote-block . org-md-quote-block) (section . org-md-section) + (special-block . org-md--convert-to-html) (src-block . org-md-example-block) + (table . org-md--convert-to-html) (template . org-md-template) (verbatim . org-md-verbatim)) :options-alist @@ -147,6 +153,145 @@ Assume BACKEND is `md'." ;; Return updated tree. tree) + +;;; Internal functions + +(defun org-md--headline-referred-p (headline info) + "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." + (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. +STYLE is the preferred style (`atx' or `setext'). LEVEL is the +header level. TITLE is the headline title. ANCHOR is the HTML +anchor tag for the section as a string. TAGS are the tags set on +the section." + (let ((anchor-lines (and anchor (concat anchor "\n\n")))) + ;; Use "Setext" style + (if (and (eq style 'setext) (< level 3)) + (let* ((underline-char (if (= level 1) ?= ?-)) + (underline (concat (make-string (length title) underline-char) + "\n"))) + (concat "\n" anchor-lines title tags "\n" underline "\n")) + ;; Use "Atx" style + (let ((level-mark (make-string level ?#))) + (concat "\n" anchor-lines level-mark " " title tags "\n\n"))))) + +(defun org-md--build-toc (info &optional n _keyword scope) + "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. + +When optional argument SCOPE is non-nil, build a table of +contents according to the specified element." + (concat + (unless scope + (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)) + (bullet + (if (not (org-export-numbered-headline-p headline info)) "- " + (let ((prefix + (format "%d." (org-last (org-export-get-headline-number + headline info))))) + (concat prefix (make-string (max 1 (- 4 (length prefix))) + ?\s))))) + (title + (format "[%s](#%s)" + (org-export-data-with-backend + (org-export-get-alt-title headline info) + (org-export-toc-entry-backend 'md) + 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))) + (org-make-tag-string + (org-export-get-tags headline info))))) + (concat indentation bullet title tags))) + (org-export-collect-headlines info n scope) "\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). +INFO is a plist with contextual information." + (let* ((fn-num (car footnote)) + (fn-text (cdr footnote)) + (fn-format (plist-get info :md-footnote-format)) + (fn-anchor (format "fn.%d" fn-num)) + (fn-href (format " href=\"#fnr.%d\"" fn-num)) + (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info))) + (concat (format fn-format fn-link-to-ref) " " fn-text "\n"))) + +(defun org-md--footnote-section (info) + "Format the footnote section. +INFO is a plist used as a communication channel." + (let* ((fn-alist (org-export-collect-footnote-definitions info)) + (fn-alist (cl-loop for (n _type raw) in fn-alist collect + (cons n (org-trim (org-export-data raw info))))) + (headline-style (plist-get info :md-headline-style)) + (section-title (org-html--translate "Footnotes" info))) + (when fn-alist + (format (plist-get info :md-footnotes-section) + (org-md--headline-title headline-style 1 section-title) + (mapconcat (lambda (fn) (org-md--footnote-formatted fn info)) + fn-alist + "\n"))))) + +(defun org-md--convert-to-html (datum _contents info) + "Convert DATUM into raw HTML, including contents." + (org-export-data-with-backend datum 'html info)) + +(defun org-md--identity (_datum contents _info) + "Return CONTENTS only." + contents) ;;; Transcode Functions @@ -242,65 +387,6 @@ a communication channel." (concat (org-md--headline-title style level heading anchor tags) contents))))))) - -(defun org-md--headline-referred-p (headline info) - "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." - (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. -STYLE is the preferred style (`atx' or `setext'). LEVEL is the -header level. TITLE is the headline title. ANCHOR is the HTML -anchor tag for the section as a string. TAGS are the tags set on -the section." - (let ((anchor-lines (and anchor (concat anchor "\n\n")))) - ;; Use "Setext" style - (if (and (eq style 'setext) (< level 3)) - (let* ((underline-char (if (= level 1) ?= ?-)) - (underline (concat (make-string (length title) underline-char) - "\n"))) - (concat "\n" anchor-lines title tags "\n" underline "\n")) - ;; Use "Atx" style - (let ((level-mark (make-string level ?#))) - (concat "\n" anchor-lines level-mark " " title tags "\n\n"))))) - ;;;; Horizontal Rule (defun org-md-horizontal-rule (_horizontal-rule _contents _info) @@ -385,20 +471,28 @@ channel." ;;;; Link -(defun org-md-link (link contents info) - "Transcode LINE-BREAK object into Markdown format. -CONTENTS is the link's description. INFO is a plist used as -a communication channel." - (let ((link-org-files-as-md - (lambda (raw-path) - ;; Treat links to `file.org' as links to `file.md'. - (if (string= ".org" (downcase (file-name-extension raw-path "."))) - (concat (file-name-sans-extension raw-path) ".md") - raw-path))) - (type (org-element-property :type link))) +(defun org-md-link (link desc info) + "Transcode LINK object into Markdown format. +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((link-org-files-as-md + (lambda (raw-path) + ;; Treat links to `file.org' as links to `file.md'. + (if (string= ".org" (downcase (file-name-extension raw-path "."))) + (concat (file-name-sans-extension raw-path) ".md") + raw-path))) + (type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string-equal type "file") + (org-export-file-uri (funcall link-org-files-as-md raw-path))) + (t raw-path)))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link contents 'md)) + ((org-export-custom-protocol-maybe link desc 'md info)) ((member type '("custom-id" "id" "fuzzy")) (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) @@ -406,13 +500,13 @@ a communication channel." (pcase (org-element-type destination) (`plain-text ; External file. (let ((path (funcall link-org-files-as-md destination))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path)))) + (if (not desc) (format "<%s>" path) + (format "[%s](%s)" desc path)))) (`headline (format "[%s](#%s)" ;; Description. - (cond ((org-string-nw-p contents)) + (cond ((org-string-nw-p desc)) ((org-export-numbered-headline-p destination info) (mapconcat #'number-to-string (org-export-get-headline-number destination info) @@ -424,7 +518,7 @@ a communication channel." (org-export-get-reference destination info)))) (_ (let ((description - (or (org-string-nw-p contents) + (or (org-string-nw-p desc) (let ((number (org-export-get-ordinal destination info))) (cond ((not number) nil) @@ -435,31 +529,23 @@ a communication channel." description (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))) - (cond ((not (equal "file" type)) (concat type ":" raw-path)) - ((not (file-name-absolute-p raw-path)) raw-path) - (t (expand-file-name raw-path))))) + (let ((path (cond ((not (string-equal type "file")) + (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))) + (org-export-get-parent-element link)) + info))) (format "![img](%s)" (if (not (org-string-nw-p caption)) path (format "%s \"%s\"" path caption))))) ((string= type "coderef") - (let ((ref (org-element-property :path link))) - (format (org-export-get-coderef-format ref contents) - (org-export-resolve-coderef ref info)))) - ((equal type "radio") contents) - (t (let* ((raw-path (org-element-property :path link)) - (path - (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - (org-export-file-uri (funcall link-org-files-as-md raw-path))) - (t raw-path)))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path))))))) + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))) + ((equal type "radio") desc) + (t (if (not desc) (format "<%s>" path) + (format "[%s](%s)" desc path)))))) ;;;; Node Property @@ -555,77 +641,6 @@ a communication channel." ;;;; Template -(defun org-md--build-toc (info &optional n _keyword scope) - "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. - -When optional argument SCOPE is non-nil, build a table of -contents according to the specified element." - (concat - (unless scope - (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)) - (bullet - (if (not (org-export-numbered-headline-p headline info)) "- " - (let ((prefix - (format "%d." (org-last (org-export-get-headline-number - headline info))))) - (concat prefix (make-string (max 1 (- 4 (length prefix))) - ?\s))))) - (title - (format "[%s](#%s)" - (org-export-data-with-backend - (org-export-get-alt-title headline info) - (org-export-toc-entry-backend 'md) - 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))) - (org-make-tag-string - (org-export-get-tags headline info))))) - (concat indentation bullet title tags))) - (org-export-collect-headlines info n scope) "\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). -INFO is a plist with contextual information." - (let* ((fn-num (car footnote)) - (fn-text (cdr footnote)) - (fn-format (plist-get info :md-footnote-format)) - (fn-anchor (format "fn.%d" fn-num)) - (fn-href (format " href=\"#fnr.%d\"" fn-num)) - (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info))) - (concat (format fn-format fn-link-to-ref) " " fn-text "\n"))) - -(defun org-md--footnote-section (info) - "Format the footnote section. -INFO is a plist used as a communication channel." - (let* ((fn-alist (org-export-collect-footnote-definitions info)) - (fn-alist (cl-loop for (n _type raw) in fn-alist collect - (cons n (org-trim (org-export-data raw info))))) - (headline-style (plist-get info :md-headline-style)) - (section-title (org-html--translate "Footnotes" info))) - (when fn-alist - (format (plist-get info :md-footnotes-section) - (org-md--headline-title headline-style 1 section-title) - (mapconcat (lambda (fn) (org-md--footnote-formatted fn info)) - fn-alist - "\n"))))) - (defun org-md-inner-template (contents info) "Return body of document after converting it to Markdown syntax. CONTENTS is the transcoded contents string. INFO is a plist diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 51cb42a49a5..3b90d03b1d7 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -96,7 +96,7 @@ (if a (org-odt-export-to-odt t s v) (org-open-file (org-odt-export-to-odt nil s v) 'system)))))) :options-alist - '((:odt-styles-file "ODT_STYLES_FILE" nil nil t) + '((:odt-styles-file "ODT_STYLES_FILE" nil org-odt-styles-file t) (:description "DESCRIPTION" nil nil newline) (:keywords "KEYWORDS" nil nil space) (:subtitle "SUBTITLE" nil nil parse) @@ -110,7 +110,6 @@ (:odt-inline-formula-rules nil nil org-odt-inline-formula-rules) (:odt-inline-image-rules nil nil org-odt-inline-image-rules) (:odt-pixels-per-inch nil nil org-odt-pixels-per-inch) - (:odt-styles-file nil nil org-odt-styles-file) (:odt-table-styles nil nil org-odt-table-styles) (:odt-use-date-fields nil nil org-odt-use-date-fields) ;; Redefine regular option. @@ -741,7 +740,7 @@ link's path." :value-type (regexp :tag "Path"))) (defcustom org-odt-inline-image-rules - '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) + `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))) "Rules characterizing image files that can be inlined into ODT. A rule consists in an association whose key is the type of link @@ -940,7 +939,7 @@ See `org-odt--build-date-styles' for implementation details." (has-time-p (or (not timestamp) (org-timestamp-has-time-p timestamp))) (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" - "%Y-%m-%dT%H:%M:%S"))) + "%Y-%m-%d"))) (funcall format-timestamp timestamp format end)))) (if iso-date-p iso-date (let* ((style (if has-time-p "OrgDate2" "OrgDate1")) @@ -1383,6 +1382,8 @@ original parsed data. INFO is a plist holding export options." ;; create a manifest entry for styles.xml (org-odt-create-manifest-file-entry "text/xml" "styles.xml") + ;; Ensure we have write permissions to this file. + (set-file-modes (concat org-odt-zip-dir "styles.xml") #o600) ;; FIXME: Who is opening an empty styles.xml before this point? (with-current-buffer @@ -2199,16 +2200,15 @@ SHORT-CAPTION are strings." (defun org-odt--image-size (file info &optional user-width user-height scale dpi embed-as) (let* ((--pixels-to-cms - (function (lambda (pixels dpi) - (let ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches))))) + (lambda (pixels dpi) + (let ((cms-per-inch 2.54) + (inches (/ pixels dpi))) + (* cms-per-inch inches)))) (--size-in-cms - (function - (lambda (size-in-pixels dpi) - (and size-in-pixels - (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) - (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))) + (lambda (size-in-pixels dpi) + (and size-in-pixels + (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) + (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))) (dpi (or dpi (plist-get info :odt-pixels-per-inch))) (anchor-type (or embed-as "paragraph")) (user-width (and (not scale) user-width)) @@ -2699,13 +2699,14 @@ INFO is a plist holding contextual information. See (path (cond ((member type '("http" "https" "ftp" "mailto")) (concat type ":" raw-path)) - ((string= type "file") (org-export-file-uri raw-path)) + ((string= type "file") + (org-export-file-uri raw-path)) (t raw-path))) ;; Convert & to & for correct XML representation (path (replace-regexp-in-string "&" "&" path))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'odt)) + ((org-export-custom-protocol-maybe link desc 'odt info)) ;; Image file. ((and (not desc) imagep) (org-odt-link--inline-image link info)) ;; Formula file. @@ -2946,7 +2947,7 @@ channel." (when scheduled (concat (format "%s" - "OrgScheduledKeyword" org-deadline-string) + "OrgScheduledKeyword" org-scheduled-string) (org-odt-timestamp scheduled contents info))))))) @@ -3728,7 +3729,8 @@ contextual information." (cache-dir (file-name-directory input-file)) (cache-subdir (concat (cl-case processing-type - ((dvipng imagemagick) "ltxpng/") + ((dvipng imagemagick) + org-preview-latex-image-directory) (mathml "ltxmathml/")) (file-name-sans-extension (file-name-nondirectory input-file)))) @@ -4239,7 +4241,7 @@ Return output file's name." `((?i . ,(shell-quote-argument in-file)) (?I . ,(browse-url-file-url in-file)) (?f . ,out-fmt) - (?o . ,out-file) + (?o . ,(shell-quote-argument out-file)) (?O . ,(browse-url-file-url out-file)) (?d . , (shell-quote-argument out-dir)) (?D . ,(browse-url-file-url out-dir)) diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index 97d8d0e92b9..740419e0e38 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -165,11 +165,11 @@ CONTENTS is nil. INFO is ignored." '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE")) (org-element-keyword-interpreter keyword nil)))) -(defun org-org-link (link contents _info) +(defun org-org-link (link contents info) "Transcode LINK object back into Org syntax. CONTENTS is the description of the link, as a string, or nil. INFO is a plist containing current export state." - (or (org-export-custom-protocol-maybe link contents 'org) + (or (org-export-custom-protocol-maybe link contents 'org info) (org-element-link-interpreter link contents))) (defun org-org-template (contents info) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index a476796568c..7bb2fed6e18 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -659,8 +659,8 @@ If `:auto-sitemap' is set, publish the sitemap too. If (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)))) + ((functionp fun) (funcall fun plist)) + ((consp fun) (dolist (f fun) (funcall f plist))))) ;; Each project uses its own cache file. (org-publish-initialize-cache (car project)) (when (org-publish-property :auto-sitemap project) @@ -685,8 +685,8 @@ If `:auto-sitemap' is set, publish the sitemap too. If (org-publish-file theindex project t))) (let ((fun (org-publish-property :completion-function project))) (cond - ((consp fun) (dolist (f fun) (funcall f plist))) - ((functionp fun) (funcall fun plist))))) + ((functionp fun) (funcall fun plist)) + ((consp fun) (dolist (f fun) (funcall f plist)))))) (org-publish-write-cache-file))) @@ -754,7 +754,8 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (let* ((root (expand-file-name (file-name-as-directory (org-publish-property :base-directory project)))) - (sitemap-filename (concat root (or sitemap-filename "sitemap.org"))) + (sitemap-filename (expand-file-name (or sitemap-filename "sitemap.org") + root)) (title (or (org-publish-property :sitemap-title project) (concat "Sitemap for project " (car project)))) (style (or (org-publish-property :sitemap-style project) diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 4265a85d1b2..ff4aa704b42 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -600,7 +600,8 @@ holding export options." "^@documentencoding \\(AUTO\\)$" coding (replace-regexp-in-string - "^@documentlanguage \\(AUTO\\)$" language header t nil 1) t nil 1))) + "^@documentlanguage \\(AUTO\\)$" language header t nil 1) + t nil 1))) ;; Additional header options set by #+TEXINFO_HEADER. (let ((texinfo-header (plist-get info :texinfo-header))) (and texinfo-header (org-element-normalize-string texinfo-header))) @@ -1049,13 +1050,15 @@ INFO is a plist holding contextual information. See (raw-path (org-element-property :path link)) ;; Ensure DESC really exists, or set it to nil. (desc (and (not (string= desc "")) desc)) - (path (cond - ((member type '("http" "https" "ftp")) - (concat type ":" raw-path)) - ((string= type "file") (org-export-file-uri raw-path)) - (t raw-path)))) + (path (org-texinfo--sanitize-content + (cond + ((member type '("http" "https" "ftp")) + (concat type ":" raw-path)) + ((string-equal type "file") + (org-export-file-uri raw-path)) + (t raw-path))))) (cond - ((org-export-custom-protocol-maybe link desc 'texinfo)) + ((org-export-custom-protocol-maybe link desc 'texinfo info)) ((org-export-inline-image-p link org-texinfo-inline-image-rules) (org-texinfo--inline-image link info)) ((equal type "radio") @@ -1069,8 +1072,7 @@ INFO is a plist holding contextual information. See (org-export-resolve-id-link link info)))) (pcase (org-element-type destination) (`nil - (format org-texinfo-link-with-unknown-path-format - (org-texinfo--sanitize-content path))) + (format org-texinfo-link-with-unknown-path-format path)) ;; Id link points to an external file. (`plain-text (if desc (format "@uref{file://%s,%s}" destination desc) @@ -1088,8 +1090,7 @@ INFO is a plist holding contextual information. See (_ (org-texinfo--@ref destination desc info))))) ((string= type "mailto") (format "@email{%s}" - (concat (org-texinfo--sanitize-content path) - (and desc (concat ", " desc))))) + (concat path (and desc (concat ", " desc))))) ;; External link with a description part. ((and path desc) (format "@uref{%s, %s}" path desc)) ;; External link without a description part. diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 797efb90b79..6dd2cd4a089 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -172,12 +172,6 @@ All these properties should be back-end agnostic. Back-end specific properties are set through `org-export-define-backend'. Properties redefined there have precedence over these.") -(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS") - "List of in-buffer keywords that require special treatment. -These keywords are not directly associated to a property. The -way they are handled must be hard-coded into -`org-export--get-inbuffer-options' function.") - (defconst org-export-filters-alist '((:filter-body . org-export-filter-body-functions) (:filter-bold . org-export-filter-bold-functions) @@ -1474,104 +1468,57 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." ;; Priority is given to back-end specific options. (org-export-get-all-options backend) org-export-options-alist)) - (regexp (format "^[ \t]*#\\+%s:" - (regexp-opt (nconc (delq nil (mapcar #'cadr options)) - org-export-special-keywords)))) plist to-parse) - (letrec ((find-properties - (lambda (keyword) - ;; Return all properties associated to KEYWORD. - (let (properties) - (dolist (option options properties) - (when (equal (nth 1 option) keyword) - (cl-pushnew (car option) properties)))))) - (get-options - (lambda (&optional files) - ;; Recursively read keywords in buffer. FILES is - ;; a list of files read so far. PLIST is the current - ;; property list obtained. - (org-with-wide-buffer - (goto-char (point-min)) - (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)) - (val (org-element-property :value element))) - (cond - ;; Options in `org-export-special-keywords'. - ((equal key "SETUPFILE") - (let* ((uri (org-strip-quotes (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 uri files) - (with-temp-buffer - (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 uri files)))))) - ((equal key "OPTIONS") - (setq plist - (org-combine-plists - plist - (org-export--parse-option-keyword - val backend)))) - ((equal key "FILETAGS") - (setq plist - (org-combine-plists - plist - (list :filetags - (org-uniquify - (append - (org-split-string val ":") - (plist-get plist :filetags))))))) - (t - ;; Options in `org-export-options-alist'. - (dolist (property (funcall find-properties key)) - (setq - plist - (plist-put - plist property - ;; Handle value depending on specified - ;; BEHAVIOR. - (cl-case (nth 4 (assq property options)) - (parse - (unless (memq property to-parse) - (push property to-parse)) - ;; Even if `parse' implies `space' - ;; behavior, we separate line with - ;; "\n" so as to preserve - ;; line-breaks. However, empty - ;; lines are forbidden since `parse' - ;; doesn't allow more than one - ;; paragraph. - (let ((old (plist-get plist property))) - (cond ((not (org-string-nw-p val)) old) - (old (concat old "\n" val)) - (t val)))) - (space - (if (not (plist-get plist property)) - (org-trim val) - (concat (plist-get plist property) - " " - (org-trim val)))) - (newline - (org-trim - (concat (plist-get plist property) - "\n" - (org-trim val)))) - (split `(,@(plist-get plist property) - ,@(split-string val))) - ((t) val) - (otherwise - (if (not (plist-member plist property)) val - (plist-get plist property))))))))))))))))) + (let ((find-properties + (lambda (keyword) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (cl-pushnew (car option) properties))))))) ;; Read options in the current buffer and return value. - (funcall get-options (and buffer-file-name (list buffer-file-name))) + (dolist (entry (org-collect-keywords + (nconc (delq nil (mapcar #'cadr options)) + '("FILETAGS" "OPTIONS")))) + (pcase entry + (`("OPTIONS" . ,values) + (setq plist + (apply #'org-combine-plists + plist + (mapcar (lambda (v) + (org-export--parse-option-keyword v backend)) + values)))) + (`("FILETAGS" . ,values) + (setq plist + (plist-put plist + :filetags + (org-uniquify + (cl-mapcan (lambda (v) (org-split-string v ":")) + values))))) + (`(,keyword . ,values) + (dolist (property (funcall find-properties keyword)) + (setq plist + (plist-put + plist property + ;; Handle value depending on specified BEHAVIOR. + (cl-case (nth 4 (assq property options)) + (parse + (unless (memq property to-parse) + (push property to-parse)) + ;; Even if `parse' implies `space' behavior, we + ;; separate line with "\n" so as to preserve + ;; line-breaks. + (mapconcat #'identity values "\n")) + (space + (mapconcat #'identity values " ")) + (newline + (mapconcat #'identity values "\n")) + (split + (cl-mapcan (lambda (v) (split-string v)) values)) + ((t) + (org-last values)) + (otherwise + (car values))))))))) ;; Parse properties in TO-PARSE. Remove newline characters not ;; involved in line breaks to simulate `space' behavior. ;; Finally return options. @@ -1633,44 +1580,10 @@ process." Also look for BIND keywords in setup files. The return value is an alist where associations are (VARIABLE-NAME VALUE)." (when org-export-allow-bind-keywords - (letrec ((collect-bind - (lambda (files alist) - ;; Return an alist between variable names and their - ;; value. FILES is a list of setup files names read - ;; so far, used to avoid circular dependencies. ALIST - ;; is the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(BIND\\|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) - "BIND") - (push (read (format "(%s)" val)) alist) - ;; Enter setup file. - (let* ((uri (org-strip-quotes 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 - (unless uri-is-url - (setq default-directory - (file-name-directory uri))) - (let ((org-inhibit-startup t)) (org-mode)) - (insert (org-file-contents uri 'noerror)) - (setq alist - (funcall collect-bind - (cons uri files) - alist)))))))))) - alist))))) - ;; Return value in appropriate order of appearance. - (nreverse (funcall collect-bind nil nil))))) + (pcase (org-collect-keywords '("BIND")) + (`(("BIND" . ,values)) + (mapcar (lambda (v) (read (format "(%s)" v))) + values))))) ;; defsubst org-export-get-parent must be defined before first use, ;; was originally defined in the topology section @@ -3461,15 +3374,16 @@ Move point after the link." (goto-char (org-element-property :end link)) (let ((new-path (file-relative-name (expand-file-name path file-dir) includer-dir)) - (new-link (org-element-copy link)) - (contents (and (org-element-property :contents-begin link) - (buffer-substring - (org-element-property :contents-begin link) - (org-element-property :contents-end link))))) + (new-link (org-element-copy link))) (org-element-put-property new-link :path new-path) + (when (org-element-property :contents-begin link) + (org-element-adopt-elements new-link + (buffer-substring + (org-element-property :contents-begin link) + (org-element-property :contents-end link)))) (delete-region (org-element-property :begin link) (org-element-property :end link)) - (insert (org-element-link-interpreter new-link contents)))))) + (insert (org-element-interpret-data new-link)))))) (defun org-export--prepare-file-contents (file &optional lines ind minlevel id footnotes includer) @@ -4184,8 +4098,8 @@ meant to be translated with `org-export-data' or alike." (org-define-error 'org-link-broken "Unable to resolve link; aborting") -(defun org-export-custom-protocol-maybe (link desc backend) - "Try exporting LINK with a dedicated function. +(defun org-export-custom-protocol-maybe (link desc backend &optional info) + "Try exporting LINK object with a dedicated function. DESC is its description, as a string, or nil. BACKEND is the back-end used for export, as a symbol. @@ -4196,14 +4110,20 @@ A custom protocol has precedence over regular back-end export. The function ignores links with an implicit type (e.g., \"custom-id\")." (let ((type (org-element-property :type link))) - (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio")) + (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio" nil)) (not backend)) - (let ((protocol (org-link-get-parameter type :export))) + (let ((protocol (org-link-get-parameter type :export)) + (path (org-element-property :path link))) (and (functionp protocol) - (funcall protocol - (org-element-property :path link) - desc - backend)))))) + (condition-case nil + (funcall protocol path desc backend info) + ;; XXX: The function used (< Org 9.4) to accept only + ;; three mandatory arguments. Type-specific `:export' + ;; functions in the wild may not handle current + ;; signature. Provide backward compatibility support + ;; for them. + (wrong-number-of-arguments + (funcall protocol path desc backend)))))))) (defun org-export-get-coderef-format (path desc) "Return format string for code reference link. @@ -4332,7 +4252,7 @@ ignores white spaces and statistics cookies, if applicable." (`headline (let ((title (split-string (replace-regexp-in-string - "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" " " (org-element-property :raw-value datum))))) (delq nil (list @@ -4805,9 +4725,6 @@ code." ;; `org-export-table-row-is-special-p' are predicates used to look for ;; meta-information about the table structure. ;; -;; `org-table-has-header-p' tells when the rows before the first rule -;; should be considered as table's header. -;; ;; `org-export-table-cell-width', `org-export-table-cell-alignment' ;; and `org-export-table-cell-borders' extract information from ;; a table-cell element. @@ -5243,7 +5160,8 @@ rows (resp. columns)." (lambda (row) (when (eq (org-element-property :type row) 'standard) (cl-incf rows) - (unless first-row (setq first-row row)))) info) + (unless first-row (setq first-row row)))) + info) ;; Set number of columns. (org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info) ;; Return value. @@ -5459,7 +5377,7 @@ transcoding it." (apostrophe :utf-8 "’" :html "’")) ("da" ;; one may use: »...«, "...", ›...‹, or '...'. - ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; https://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ ;; LaTeX quotes require Babel! (primary-opening :utf-8 "»" :html "»" :latex ">>" :texinfo "@guillemetright{}") @@ -5552,8 +5470,19 @@ transcoding it." (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") (apostrophe :utf-8 "’" :html "’")) + ("ro" + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (secondary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (secondary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (apostrophe :utf-8 "’" :html "’")) ("ru" - ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 + ;; https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 ;; http://www.artlebedev.ru/kovodstvo/sections/104/ (primary-opening :utf-8 "«" :html "«" :latex "{}<<" :texinfo "@guillemetleft{}") @@ -5812,6 +5741,7 @@ them." ("nn" :default "Forfattar") ("pl" :default "Autor") ("pt_BR" :default "Autor") + ("ro" :default "Autor") ("ru" :html "Автор" :utf-8 "Автор") ("sl" :default "Avtor") ("sv" :html "Författare") @@ -5829,6 +5759,7 @@ them." ("nl" :default "Vervolg van vorige pagina") ("pt" :default "Continuação da página anterior") ("pt_BR" :html "Continuação da página anterior" :ascii "Continuacao da pagina anterior" :default "Continuação da página anterior") + ("ro" :default "Continuare de pe pagina precedentă") ("ru" :html "(Продолжение)" :utf-8 "(Продолжение)") ("sl" :default "Nadaljevanje s prejšnje strani")) @@ -5843,12 +5774,15 @@ them." ("nl" :default "Vervolg op volgende pagina") ("pt" :default "Continua na página seguinte") ("pt_BR" :html "Continua na próxima página" :ascii "Continua na proxima pagina" :default "Continua na próxima página") + ("ro" :default "Continuare pe pagina următoare") ("ru" :html "(Продолжение следует)" :utf-8 "(Продолжение следует)") ("sl" :default "Nadaljevanje na naslednji strani")) ("Created" ("cs" :default "Vytvořeno") + ("nl" :default "Gemaakt op") ;; must be followed by a date or date+time ("pt_BR" :default "Criado em") + ("ro" :default "Creat") ("sl" :default "Ustvarjeno")) ("Date" ("ar" :default "بتاريخ") @@ -5869,6 +5803,7 @@ them." ("nb" :default "Dato") ("nn" :default "Dato") ("pl" :default "Data") + ("ro" :default "Data") ("pt_BR" :default "Data") ("ru" :html "Дата" :utf-8 "Дата") ("sl" :default "Datum") @@ -5886,10 +5821,12 @@ them." ("fr" :ascii "Equation" :default "Équation") ("is" :default "Jafna") ("ja" :default "方程式") + ("nl" :default "Vergelijking") ("no" :default "Ligning") ("nb" :default "Ligning") ("nn" :default "Likning") ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") + ("ro" :default "Ecuația") ("ru" :html "Уравнение" :utf-8 "Уравнение") ("sl" :default "Enačba") @@ -5905,10 +5842,12 @@ them." ("is" :default "Mynd") ("it" :default "Figura") ("ja" :default "図" :html "図") + ("nl" :default "Figuur") ("no" :default "Illustrasjon") ("nb" :default "Illustrasjon") ("nn" :default "Illustrasjon") ("pt_BR" :default "Figura") + ("ro" :default "Imaginea") ("ru" :html "Рисунок" :utf-8 "Рисунок") ("sv" :default "Illustration") ("zh-CN" :html "图" :utf-8 "图")) @@ -5923,10 +5862,12 @@ them." ("is" :default "Mynd %d") ("it" :default "Figura %d:") ("ja" :default "図%d: " :html "図%d: ") + ("nl" :default "Figuur %d:" :html "Figuur %d:") ("no" :default "Illustrasjon %d") ("nb" :default "Illustrasjon %d") ("nn" :default "Illustrasjon %d") ("pt_BR" :default "Figura %d:") + ("ro" :default "Imaginea %d:") ("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:") ("sl" :default "Slika %d") ("sv" :default "Illustration %d") @@ -5952,6 +5893,7 @@ them." ("nn" :default "Fotnotar") ("pl" :default "Przypis") ("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape") + ("ro" :default "Note de subsol") ("ru" :html "Сноски" :utf-8 "Сноски") ("sl" :default "Opombe") ("sv" :default "Fotnoter") @@ -5968,6 +5910,7 @@ them." ("et" :default "Loendite nimekiri") ("fr" :default "Liste des programmes") ("ja" :default "ソースコード目次") + ("nl" :default "Lijst van programma's") ("no" :default "Dataprogrammer") ("nb" :default "Dataprogrammer") ("pt_BR" :html "Índice de Listagens" :default "Índice de Listagens" :ascii "Indice de Listagens") @@ -5986,10 +5929,12 @@ them." ("is" :default "Töfluskrá" :html "Töfluskrá") ("it" :default "Indice delle tabelle") ("ja" :default "表目次") + ("nl" :default "Lijst van tabellen") ("no" :default "Tabeller") ("nb" :default "Tabeller") ("nn" :default "Tabeller") ("pt_BR" :html "Índice de Tabelas" :default "Índice de Tabelas" :ascii "Indice de Tabelas") + ("ro" :default "Tabele") ("ru" :html "Список таблиц" :utf-8 "Список таблиц") ("sl" :default "Seznam tabel") @@ -6005,9 +5950,11 @@ them." ("fr" :default "Programme" :html "Programme") ("it" :default "Listato") ("ja" :default "ソースコード") + ("nl" :default "Programma") ("no" :default "Dataprogram") ("nb" :default "Dataprogram") ("pt_BR" :default "Listagem") + ("ro" :default "Lista") ("ru" :html "Распечатка" :utf-8 "Распечатка") ("sl" :default "Izpis programa") @@ -6022,8 +5969,10 @@ them." ("fr" :default "Programme %d :" :html "Programme %d :") ("it" :default "Listato %d :") ("ja" :default "ソースコード%d:") + ("nl" :default "Programma %d:" :html "Programma %d:") ("no" :default "Dataprogram %d") ("nb" :default "Dataprogram %d") + ("ro" :default "Lista %d") ("pt_BR" :default "Listagem %d:") ("ru" :html "Распечатка %d.:" :utf-8 "Распечатка %d.:") @@ -6036,20 +5985,28 @@ them." ("es" :default "Referencias") ("fr" :ascii "References" :default "Références") ("it" :default "Riferimenti") + ("nl" :default "Bronverwijzingen") ("pt_BR" :html "Referências" :default "Referências" :ascii "Referencias") + ("ro" :default "Bibliografie") ("sl" :default "Reference")) ("See figure %s" ("cs" :default "Viz obrázek %s") ("fr" :default "cf. figure %s" :html "cf. figure %s" :latex "cf.~figure~%s") ("it" :default "Vedi figura %s") + ("nl" :default "Zie figuur %s" + :html "Zie figuur %s" :latex "Zie figuur~%s") ("pt_BR" :default "Veja a figura %s") + ("ro" :default "Vezi figura %s") ("sl" :default "Glej sliko %s")) ("See listing %s" ("cs" :default "Viz program %s") ("fr" :default "cf. programme %s" :html "cf. programme %s" :latex "cf.~programme~%s") + ("nl" :default "Zie programma %s" + :html "Zie programma %s" :latex "Zie programma~%s") ("pt_BR" :default "Veja a listagem %s") + ("ro" :default "Vezi tabelul %s") ("sl" :default "Glej izpis programa %s")) ("See section %s" ("ar" :default "انظر قسم %s") @@ -6061,8 +6018,11 @@ them." ("fr" :default "cf. section %s") ("it" :default "Vedi sezione %s") ("ja" :default "セクション %s を参照") + ("nl" :default "Zie sectie %s" + :html "Zie sectie %s" :latex "Zie sectie~%s") ("pt_BR" :html "Veja a seção %s" :default "Veja a seção %s" :ascii "Veja a secao %s") + ("ro" :default "Vezi secțiunea %s") ("ru" :html "См. раздел %s" :utf-8 "См. раздел %s") ("sl" :default "Glej poglavje %d") @@ -6072,7 +6032,10 @@ them." ("fr" :default "cf. tableau %s" :html "cf. tableau %s" :latex "cf.~tableau~%s") ("it" :default "Vedi tabella %s") + ("nl" :default "Zie tabel %s" + :html "Zie tabel %s" :latex "Zie tabel~%s") ("pt_BR" :default "Veja a tabela %s") + ("ro" :default "Vezi tabelul %s") ("sl" :default "Glej tabelo %s")) ("Table" ("ar" :default "جدول") @@ -6084,7 +6047,9 @@ them." ("is" :default "Tafla") ("it" :default "Tabella") ("ja" :default "表" :html "表") + ("nl" :default "Tabel") ("pt_BR" :default "Tabela") + ("ro" :default "Tabel") ("ru" :html "Таблица" :utf-8 "Таблица") ("zh-CN" :html "表" :utf-8 "表")) @@ -6099,10 +6064,12 @@ them." ("is" :default "Tafla %d") ("it" :default "Tabella %d:") ("ja" :default "表%d:" :html "表%d:") + ("nl" :default "Tabel %d:" :html "Tabel %d:") ("no" :default "Tabell %d") ("nb" :default "Tabell %d") ("nn" :default "Tabell %d") ("pt_BR" :default "Tabela %d:") + ("ro" :default "Tabel %d") ("ru" :html "Таблица %d.:" :utf-8 "Таблица %d.:") ("sl" :default "Tabela %d") @@ -6129,6 +6096,7 @@ them." ("nn" :default "Innhald") ("pl" :html "Spis treści") ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") + ("ro" :default "Cuprins") ("ru" :html "Содержание" :utf-8 "Содержание") ("sl" :default "Kazalo") @@ -6145,7 +6113,9 @@ them." ("fr" :ascii "Destination inconnue" :default "Référence inconnue") ("it" :default "Riferimento sconosciuto") ("ja" :default "不明な参照先") + ("nl" :default "Onbekende verwijzing") ("pt_BR" :html "Referência desconhecida" :default "Referência desconhecida" :ascii "Referencia desconhecida") + ("ro" :default "Referință necunoscută") ("ru" :html "Неизвестная ссылка" :utf-8 "Неизвестная ссылка") ("sl" :default "Neznana referenca") @@ -6877,10 +6847,12 @@ back to standard interface." (with-current-buffer "*Org Export Dispatcher*" ;; Refresh help. Maintain display continuity by re-visiting ;; previous window position. - (let ((pos (window-start))) + (let ((pt (point)) + (wstart (window-start))) (erase-buffer) (insert help) - (set-window-start nil pos))) + (goto-char pt) + (set-window-start nil wstart))) (org-fit-window-to-buffer) (org-export--dispatch-action standard-prompt allowed-keys entries options first-key expertp)))) @@ -6903,24 +6875,10 @@ options as CDR." ;; C-p, SPC, DEL). (while (and (setq key (read-char-exclusive prompt)) (not expertp) - (memq key '(14 16 ?\s ?\d))) - (cl-case key - (14 (if (not (pos-visible-in-window-p (point-max))) - (ignore-errors (scroll-up 1)) - (message "End of buffer") - (sit-for 1))) - (16 (if (not (pos-visible-in-window-p (point-min))) - (ignore-errors (scroll-down 1)) - (message "Beginning of buffer") - (sit-for 1))) - (?\s (if (not (pos-visible-in-window-p (point-max))) - (scroll-up nil) - (message "End of buffer") - (sit-for 1))) - (?\d (if (not (pos-visible-in-window-p (point-min))) - (scroll-down nil) - (message "Beginning of buffer") - (sit-for 1))))) + ;; FIXME: Don't use C-v (22) here, as it is used as a + ;; modifier key in the export dispatch. + (memq key '(14 16 ?\s ?\d 134217846))) + (org-scroll key t)) (cond ;; Ignore undefined associations. ((not (memq key allowed-keys)) @@ -6929,7 +6887,7 @@ options as CDR." (org-export--dispatch-ui options first-key expertp)) ;; q key at first level aborts export. At second level, cancel ;; first key instead. - ((eq key ?q) (if (not first-key) (error "Export aborted") + ((eq key ?q) (if (not first-key) (user-error "Export aborted") (org-export--dispatch-ui options nil expertp))) ;; Help key: Switch back to standard interface if expert UI was ;; active. From 1c115e404e38d04b179a00c2ed1bbd48ff070984 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 13 Dec 2020 13:49:25 +0100 Subject: [PATCH 039/148] Clarify Extended Menu Items a bit more * doc/lispref/keymaps.texi (Extended Menu Items): Expand a bit more on how submenus are formed (bug#26428). --- doc/lispref/keymaps.texi | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 130ff0d8671..6635f50960a 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2167,9 +2167,10 @@ string. Thus, the string need not be a constant. The third element, @var{real-binding}, can be the command to execute (in which case you get a normal menu item). It can also be a keymap, -which will result in a submenu. Finally, it can be @code{nil}, in -which case you will get a non-selectable menu item. This is mostly -useful when creating separator lines and the like. +which will result in a submenu, and @var{item-name} is used as the +submenu name. Finally, it can be @code{nil}, in which case you will +get a non-selectable menu item. This is mostly useful when creating +separator lines and the like. The tail of the list, @var{item-property-list}, has the form of a property list which contains other information. From f7133be7ae4eda5b3688728f19cac39de7e862a3 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 13 Dec 2020 14:17:55 +0100 Subject: [PATCH 040/148] Make dired-toggle-read-only query on read-only directories * lisp/dired.el (dired-toggle-read-only): Query instead of erroring out immediately (bug#29412). --- lisp/dired.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index baf99da7b48..c68c4a52bd4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2419,8 +2419,10 @@ If the current buffer can be edited with Wdired, (i.e. the major mode is `dired-mode'), call `wdired-change-to-wdired-mode'. Otherwise, toggle `read-only-mode'." (interactive) - (unless (file-writable-p default-directory) - (user-error "Directory %s isn't writeable" default-directory)) + (when (and (not (file-writable-p default-directory)) + (not (y-or-n-p + "Directory isn't writable; edit anyway? "))) + (user-error "Directory %s isn't writable" default-directory)) (if (derived-mode-p 'dired-mode) (wdired-change-to-wdired-mode) (read-only-mode 'toggle))) From 897b8561cdc856fb40b2a3c6f29230849aaf4a34 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Sun, 13 Dec 2020 10:44:30 -0300 Subject: [PATCH 041/148] Stop dropping the tag when creating the custom-variable widget * lisp/cus-edit.el (custom-variable-value-create): Obey the specified tag format when creating the variable tag, but stop dropping the tag format for the variable's type widget, since the tag can be used to give useful information to the user about the variable. (Bug#35133) --- lisp/cus-edit.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 3a36cb02373..041f13b420b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2734,11 +2734,15 @@ try matching its doc string against `custom-guess-doc-alist'." buttons) (insert " ") (let* ((format (widget-get type :format)) - tag-format value-format) - (unless (string-match ":" format) + tag-format) + ;; We used to drop the widget tag when creating TYPE, passing + ;; everything after the colon (including whitespace characters + ;; after it) as the :format for TYPE. We don't drop the tag + ;; anymore, but we should keep an immediate whitespace character, + ;; if present, and it's easier to do it here. + (unless (string-match ":\\s-?" format) (error "Bad format")) (setq tag-format (substring format 0 (match-end 0))) - (setq value-format (substring format (match-end 0))) (push (widget-create-child-and-convert widget 'item :format tag-format @@ -2753,7 +2757,6 @@ try matching its doc string against `custom-guess-doc-alist'." buttons) (push (widget-create-child-and-convert widget type - :format value-format :value value) children)))) (unless (eq custom-buffer-style 'tree) From fe50a8b9ba79b4ac14a3a352d8bf84eaee4f2122 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 13 Dec 2020 17:13:50 +0100 Subject: [PATCH 042/148] Byte compilation: handle case where the output file is a mountpoint. See Bug#44631. While testing for a readonly output directory has slightly different semantics, in practice they should cover cases where Emacs is sandboxed and can only write to the destination file, not its directory. * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Handle the case where the output directory is not writable. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--not-writable-directory) (bytecomp-tests--dest-mountpoint): New unit tests. --- lisp/emacs-lisp/bytecomp.el | 14 +++++- test/lisp/emacs-lisp/bytecomp-tests.el | 69 ++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 51accc08654..e23bb9f5e6e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1963,7 +1963,11 @@ See also `emacs-lisp-byte-compile-and-load'." (insert "\n") ; aaah, unix. (cond ((null target-file) nil) ;We only wanted the warnings! - ((file-writable-p target-file) + ((and (file-writable-p target-file) + ;; We attempt to create a temporary file in the + ;; target directory, so the target directory must be + ;; writable. + (file-writable-p (file-name-directory 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 @@ -1992,6 +1996,14 @@ See also `emacs-lisp-byte-compile-and-load'." ;; deleting target-file before writing it. (rename-file tempfile target-file t)) (or noninteractive (message "Wrote %s" target-file))) + ((file-writable-p target-file) + ;; In case the target directory isn't writable (see e.g. Bug#44631), + ;; try writing to the output file directly. We must disable any + ;; code conversion here. + (let ((coding-system-for-write 'no-conversion)) + (with-file-modes (logand (default-file-modes) #o666) + (write-region (point-min) (point-max) target-file nil 1))) + (or noninteractive (message "Wrote %s" target-file))) (t ;; This is just to give a better error message than write-region (let ((exists (file-exists-p target-file))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8fa4d278f11..c2a3e3ba117 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -947,6 +947,75 @@ literals (Bug#20852)." '((suspicious set-buffer)) "Warning: Use .with-current-buffer. rather than")) +(ert-deftest bytecomp-tests--not-writable-directory () + "Test that byte compilation works if the output directory isn't +writable (Bug#44631)." + (let ((directory (make-temp-file "bytecomp-tests-" :directory))) + (unwind-protect + (let* ((input-file (expand-file-name "test.el" directory)) + (output-file (expand-file-name "test.elc" directory)) + (byte-compile-dest-file-function + (lambda (_) output-file)) + (byte-compile-error-on-warn t)) + (write-region "" nil input-file nil nil nil 'excl) + (write-region "" nil output-file nil nil nil 'excl) + (set-file-modes input-file #o400) + (set-file-modes output-file #o200) + (set-file-modes directory #o500) + (should (byte-compile-file input-file)) + (should (file-regular-p output-file)) + (should (cl-plusp (file-attribute-size + (file-attributes output-file))))) + (with-demoted-errors "Error cleaning up directory: %s" + (set-file-modes directory #o700) + (delete-directory directory :recursive))))) + +(ert-deftest bytecomp-tests--dest-mountpoint () + "Test that byte compilation works if the destination file is a +mountpoint (Bug#44631)." + (let ((bwrap (executable-find "bwrap")) + (emacs (expand-file-name invocation-name invocation-directory))) + (skip-unless bwrap) + (skip-unless (file-executable-p bwrap)) + (skip-unless (not (file-remote-p bwrap))) + (skip-unless (file-executable-p emacs)) + (skip-unless (not (file-remote-p emacs))) + (let ((directory (make-temp-file "bytecomp-tests-" :directory))) + (unwind-protect + (let* ((input-file (expand-file-name "test.el" directory)) + (output-file (expand-file-name "test.elc" directory)) + (unquoted-file (file-name-unquote output-file)) + (byte-compile-dest-file-function + (lambda (_) output-file)) + (byte-compile-error-on-warn t)) + (should-not (file-remote-p input-file)) + (should-not (file-remote-p output-file)) + (write-region "" nil input-file nil nil nil 'excl) + (write-region "" nil output-file nil nil nil 'excl) + (set-file-modes input-file #o400) + (set-file-modes output-file #o200) + (set-file-modes directory #o500) + (with-temp-buffer + (let ((status (call-process + bwrap nil t nil + "--ro-bind" "/" "/" + "--bind" unquoted-file unquoted-file + emacs "--quick" "--batch" "--load=bytecomp" + (format "--eval=%S" + `(setq byte-compile-dest-file-function + (lambda (_) ,output-file) + byte-compile-error-on-warn t)) + "--funcall=batch-byte-compile" input-file))) + (unless (eql status 0) + (ert-fail `((status . ,status) + (output . ,(buffer-string))))))) + (should (file-regular-p output-file)) + (should (cl-plusp (file-attribute-size + (file-attributes output-file))))) + (with-demoted-errors "Error cleaning up directory: %s" + (set-file-modes directory #o700) + (delete-directory directory :recursive)))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: From 51698f77dd6356049fcacdb01ebe80cfe4c67272 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 13 Dec 2020 22:50:46 +0200 Subject: [PATCH 043/148] Remove the duplication from project-switch-commands's config Based on an older patch by Philip K (https://debbugs.gnu.org/41890#127). * lisp/progmodes/project.el: (project-switch-commands): Change to 'defcustom', alter the value format, add :type. (project-switch-use-entire-map): New option. (project--keymap-prompt, project-switch-project): Update accordingly, while keeping compatibility with user-defined values in the previous format (for some transition period). Co-authored-by: Philip K. --- lisp/progmodes/project.el | 84 ++++++++++++++++++++++++++++++--------- 1 file changed, 65 insertions(+), 19 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 0ed5f1f907c..d4c0e46c851 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1250,27 +1250,55 @@ It's also possible to enter an arbitrary directory not in the list." ;;; Project switching ;;;###autoload -(defvar project-switch-commands - '((?f "Find file" project-find-file) - (?g "Find regexp" project-find-regexp) - (?d "Dired" project-dired) - (?v "VC-Dir" project-vc-dir) - (?e "Eshell" project-eshell)) - "Alist mapping keys to project switching menu entries. +(defcustom project-switch-commands + '((project-find-file "Find file") + (project-find-regexp "Find regexp") + (project-dired "Dired") + (project-vc-dir "VC-Dir") + (project-eshell "Eshell")) + "Alist mapping commands to descriptions. Used by `project-switch-project' to construct a dispatch menu of commands available upon \"switching\" to another project. -Each element is of the form (KEY LABEL COMMAND), where COMMAND is the -command to run when KEY is pressed. LABEL is used to distinguish -the menu entries in the dispatch menu.") +Each element is of the form (COMMAND LABEL &optional KEY) where +COMMAND is the command to run when KEY is pressed. LABEL is used +to distinguish the menu entries in the dispatch menu. If KEY is +absent, COMMAND must be bound in `project-prefix-map', and the +key is looked up in that map." + :version "28.1" + :package-version '(project . "0.6.0") + :type '(repeat + (list + (symbol :tag "Command") + (string :tag "Label") + (choice :tag "Key to press" + (const :tag "Infer from the keymap" nil) + (character :tag "Explicit key"))))) + +(defcustom project-switch-use-entire-map nil + "Make `project-switch-project' use entire `project-prefix-map'. +If nil, `project-switch-project' will only recognize commands +listed in `project-switch-commands' and signal an error when +others are invoked. Otherwise, all keys in `project-prefix-map' +are legal even if they aren't listed in the dispatch menu." + :type 'bool + :version "28.1") (defun project--keymap-prompt () "Return a prompt for the project switching dispatch menu." (mapconcat - (pcase-lambda (`(,key ,label)) - (format "[%s] %s" - (propertize (key-description `(,key)) 'face 'bold) - label)) + (pcase-lambda (`(,cmd ,label ,key)) + (when (characterp cmd) ; Old format, apparently user-customized. + (let ((tmp cmd)) + ;; TODO: Add a deprecation warning, probably. + (setq cmd key + key tmp))) + (let ((key (if key + (vector key) + (where-is-internal cmd project-prefix-map t)))) + (format "[%s] %s" + (propertize (key-description key) 'face 'bold) + label))) project-switch-commands " ")) @@ -1283,13 +1311,31 @@ made from `project-switch-commands'. When called in a program, it will use the project corresponding to directory DIR." (interactive (list (project-prompt-project-dir))) - (let ((choice nil)) - (while (not choice) - (setq choice (assq (read-event (project--keymap-prompt)) - project-switch-commands))) + (let ((commands-menu + (mapcar + (lambda (row) + (if (characterp (car row)) + ;; Deprecated format. + ;; XXX: Add a warning about it? + (reverse row) + row)) + project-switch-commands)) + command) + (while (not command) + (let ((choice (read-event (project--keymap-prompt)))) + (when (setq command + (or (car + (seq-find (lambda (row) (equal choice (nth 2 row))) + commands-menu)) + (lookup-key project-prefix-map (vector choice)))) + (unless (or project-switch-use-entire-map + (assq command commands-menu)) + ;; TODO: Add some hint to the prompt, like "key not + ;; recognized" or something. + (setq command nil))))) (let ((default-directory dir) (project-current-inhibit-prompt t)) - (call-interactively (nth 2 choice))))) + (call-interactively command)))) (provide 'project) ;;; project.el ends here From 2dbc95063b5ee3d48aceff05f89e63a134df86ed Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sun, 13 Dec 2020 22:26:51 +0100 Subject: [PATCH 044/148] Update to Org 9.4.2 Mostly fixing compiler warnings. --- etc/refcards/orgcard.tex | 2 +- lisp/org/ob-ruby.el | 11 +++++++---- lisp/org/ol-bibtex.el | 2 ++ lisp/org/ol.el | 2 ++ lisp/org/org-compat.el | 2 ++ lisp/org/org-entities.el | 1 + lisp/org/org-list.el | 1 + lisp/org/org-macs.el | 1 + lisp/org/org-src.el | 1 + lisp/org/org-table.el | 3 +++ lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 5 +++-- 12 files changed, 26 insertions(+), 9 deletions(-) diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index b890fe2ca83..5613fdd6527 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.4.1} +\def\orgversionnumber{9.4.2} \def\versionyear{2019} % latest update \input emacsver.tex diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 5ed29f8891a..2e33bfa29af 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -159,13 +159,16 @@ 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* ((cmd (cdr (or (assq :ruby params) - (assoc inf-ruby-default-implementation - inf-ruby-implementations)))) + (let* ((command (cdr (or (assq :ruby params) + (assoc inf-ruby-default-implementation + inf-ruby-implementations)))) (buffer (get-buffer (format "*%s*" session))) (session-buffer (or buffer (save-window-excursion (run-ruby-or-pop-to-buffer - cmd (or session "ruby") + (if (functionp command) + (funcall command) + command) + (or session "ruby") (unless session (inf-ruby-buffer))) (current-buffer))))) diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el index e8f246e7f64..bf25d22057b 100644 --- a/lisp/org/ol-bibtex.el +++ b/lisp/org/ol-bibtex.el @@ -137,6 +137,8 @@ (declare-function org-set-property "org" (property value)) (declare-function org-toggle-tag "org" (tag &optional onoff)) +(declare-function org-search-view "org-agenda" (&optional todo-only string edit-at)) + ;;; Bibtex data (defvar org-bibtex-types diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 77ca21e2643..5bb01e3f5fd 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -63,10 +63,12 @@ (declare-function org-insert-heading "org" (&optional arg invisible-ok top)) (declare-function org-load-modules-maybe "org" (&optional force)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-mode "org" ()) (declare-function org-occur "org" (regexp &optional keep-previous callback)) (declare-function org-open-file "org" (path &optional in-emacs line search)) (declare-function org-overview "org" ()) (declare-function org-restart-font-lock "org" ()) +(declare-function org-run-like-in-org-mode "org" (cmd)) (declare-function org-show-context "org" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index e4d8658197c..6e9e248d23a 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -34,7 +34,9 @@ (declare-function org-agenda-diary-entry "org-agenda") (declare-function org-agenda-maybe-redo "org-agenda" ()) +(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) (declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate)) +(declare-function org-calendar-goto-agenda "org-agenda" ()) (declare-function org-align-tags "org" (&optional all)) (declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-at-table.el-p "org" ()) diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index bca0c4338a3..b2878609d87 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -27,6 +27,7 @@ ;;; Code: +(declare-function org-mode "org" ()) (declare-function org-toggle-pretty-entities "org" ()) (declare-function org-table-align "org-table" ()) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index b8383283be8..dc7dc2a2c26 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -132,6 +132,7 @@ (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-mode "org" ()) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-outline-level "org" ()) (declare-function org-previous-line-empty-p "org" ()) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index f25efe07f33..f375c33d96a 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -34,6 +34,7 @@ (require 'cl-lib) (require 'format-spec) +(declare-function org-mode "org" ()) (declare-function org-show-context "org" (&optional key)) (declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 28733d0115b..b4e54083d24 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -37,6 +37,7 @@ (require 'org-compat) (require 'org-keys) +(declare-function org-mode "org" ()) (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)) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 8dd3f392d2d..546326d0d58 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -44,6 +44,9 @@ (declare-function face-remap-add-relative "face-remap" (face &rest specs)) (declare-function org-at-timestamp-p "org" (&optional extended)) (declare-function org-delete-backward-char "org" (N)) +(declare-function org-mode "org" ()) +(declare-function org-duration-p "org-duration" (duration &optional canonical)) +(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical)) (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)) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index a5219a0e11b..738dbd663c1 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.4.1")) + (let ((org-release "9.4.2")) 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.4.1-116-g353bb4")) + (let ((org-git-version "release_9.4.2")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 3db07cd89b3..063d0449d29 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -8,7 +8,7 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: https://orgmode.org -;; Version: 9.4.1 +;; Version: 9.4.2 ;; This file is part of GNU Emacs. ;; @@ -149,6 +149,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-columns-quit "org-colview" ()) (declare-function org-columns-insert-dblock "org-colview" ()) (declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt canonical)) +(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical)) (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)) @@ -4179,7 +4180,7 @@ After a match, the following groups carry important information: "Variable associated with STARTUP options for Org. Each element is a list of three items: the startup options (as written 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 +this variable to if the option is found. An optional fourth element PUSH means to push this value onto the list in the variable.") (defcustom org-group-tags t From 755a9f2a8b1118e2493af4c16126da8241aae397 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 13 Dec 2020 23:08:42 +0000 Subject: [PATCH 045/148] Inhibit quit in ElDoc timer functions (bug#45117) The point of un-inhibiting it was to make ElDoc backends interruptible with any input (as in while-no-input), since that should in principle invalidate the need of the current ElDoc processing. But that strategy is dangerous for backends that perform complex synchronization with external processes. Better let each backend decide for itself it needs this eager interruptive behavior, like is presumably the case with the Octave backend. This reverts a part of commit 12e922156c86a26fa4bb2cb9e7d2b3fd639e4707 Author: Stefan Monnier Date: Tue Dec 4 18:15:44 2018 -0500 * lisp/emacs-lisp/eldoc.el (eldoc-print-current-symbol-info): * lisp/progmodes/octave.el (octave-eldoc-function-signatures): Use while-no-input. --- lisp/emacs-lisp/eldoc.el | 6 +----- lisp/progmodes/octave.el | 5 +++-- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 6a976841038..c9d5521e502 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -867,11 +867,7 @@ the docstrings eventually produced, using eldoc--last-request-state)) (let ((non-essential t)) (setq eldoc--last-request-state token) - ;; Only keep looking for the info as long as the user hasn't - ;; requested our attention. This also locally disables - ;; inhibit-quit. - (while-no-input - (eldoc--invoke-strategy nil))))))) + (eldoc--invoke-strategy nil)))))) ;; This section only affects ElDoc output to the echo area, as in diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index c313ad11792..bda4e60c55c 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1605,8 +1605,9 @@ code line." (defun octave-eldoc-function-signatures (fn) (unless (equal fn (car octave-eldoc-cache)) - (inferior-octave-send-list-and-digest - (list (format "print_usage ('%s');\n" fn))) + (while-no-input + (inferior-octave-send-list-and-digest + (list (format "print_usage ('%s');\n" fn)))) (let (result) (dolist (line inferior-octave-output-list) ;; The help output has changed a few times in GNU Octave. From dc6e616dfea1a740248b8f73b35851f7b167ec16 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 14 Dec 2020 10:44:04 +0200 Subject: [PATCH 046/148] Don't show matches with no input for nil icomplete-show-matches-on-no-input * lisp/icomplete.el (icomplete-show-matches-on-no-input): Fix docstring. (icomplete--initial-input): New internal variable. (icomplete-minibuffer-setup): Set buffer-local icomplete--initial-input to icomplete--field-string. (icomplete-ret, icomplete-force-complete-and-exit) (icomplete--sorted-completions, icomplete-exhibit): Compare icomplete--initial-input with icomplete--field-string to detect no input. (Bug#19031) etc/NEWS: Remove duplicate entry. --- etc/NEWS | 10 +++------- lisp/icomplete.el | 20 ++++++++++++++------ 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 909473f4e77..02edabfc27f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1553,12 +1553,6 @@ both modes are on). This works like 'report-emacs-bug', but is more geared towards sending patches to the Emacs issue tracker. ---- -*** 'icomplete-show-matches-on-no-input' behavior change. -Previously, choosing a different completion with commands like 'C-.' -and then hitting 'RET' would choose the default completion. Doing -this will now choose the completion under point. - +++ *** The user can now customize how "default" values are prompted for. The new utility function 'format-prompt' has been added which uses the @@ -1609,7 +1603,9 @@ horizontally and vertically, respectively. *** Change in meaning of 'icomplete-show-matches-on-no-input'. Previously, choosing a different completion with commands like 'C-.' and then hitting 'RET' would choose the default completion. Doing this -will now choose the completion under point instead. +will now choose the completion under point instead. Also when this option +is nil, completions are not shown when the minibuffer reads a file name +with initial input as the default directory. --- *** The width of the buffer-name column in 'list-buffers' is now dynamic. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 0fdacd0a3c6..6627fd15f65 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -75,7 +75,9 @@ everything preceding the ~/ is discarded so the interactive selection process starts again from the user's $HOME.") (defcustom icomplete-show-matches-on-no-input nil - "When non-nil, show completions when the minibuffer is empty. + "When non-nil, show completions when first prompting for input. +This means to show completions even when the current minibuffer contents +is the same as was the initial input after minibuffer activation. This also means that if you traverse the list of completions with commands like `C-.' and just hit RET without typing any characters, the match under point will be chosen instead of the @@ -146,6 +148,10 @@ icompletion is occurring." (defvar icomplete-overlay (make-overlay (point-min) (point-min) nil t t) "Overlay used to display the list of completions.") +(defvar icomplete--initial-input nil + "Initial input in the minibuffer when icomplete-mode was activated. +Used to implement the option `icomplete-show-matches-on-no-input'.") + (defun icomplete-pre-command-hook () (let ((non-essential t)) (icomplete-tidy))) @@ -169,7 +175,7 @@ icompletion is occurring." (interactive) (if (and icomplete-show-matches-on-no-input (car completion-all-sorted-completions) - (eql (icomplete--field-end) (icomplete--field-beg))) + (equal (icomplete--field-string) icomplete--initial-input)) (icomplete-force-complete-and-exit) (minibuffer-complete-and-exit))) @@ -189,7 +195,7 @@ the default otherwise." (if (or ;; there's some input, meaning the default in off the table by ;; definition; OR - (> (icomplete--field-end) (icomplete--field-beg)) + (not (equal (icomplete--field-string) icomplete--initial-input)) ;; there's no input, but there's also no minibuffer default ;; (and the user really wants to see completions on no input, ;; meaning he expects a "force" to be at least attempted); OR @@ -441,6 +447,7 @@ Conditions are: "Run in minibuffer on activation to establish incremental completion. Usually run by inclusion in `minibuffer-setup-hook'." (when (and icomplete-mode (icomplete-simple-completing-p)) + (setq-local icomplete--initial-input (icomplete--field-string)) (setq-local completion-show-inline-help nil) (use-local-map (make-composed-keymap icomplete-minibuffer-map (current-local-map))) @@ -486,7 +493,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." ;; `completing-read' invocations, described below: for fn in (cond ((and minibuffer-default (stringp minibuffer-default) ; bug#38992 - (= (icomplete--field-end) (icomplete--field-beg))) + (equal (icomplete--field-string) icomplete--initial-input)) ;; Here, we have a non-nil string default and ;; no input whatsoever. We want to make sure ;; that the default is bubbled to the top so @@ -579,7 +586,8 @@ See `icomplete-mode' and `minibuffer-setup-hook'." (goto-char (point-max)) ; Insert the match-status information: (when (and (or icomplete-show-matches-on-no-input - (> (icomplete--field-end) (icomplete--field-beg))) + (not (equal (icomplete--field-string) + icomplete--initial-input))) (or ;; Don't bother with delay after certain number of chars: (> (- (point) (icomplete--field-beg)) @@ -602,7 +610,7 @@ See `icomplete-mode' and `minibuffer-setup-hook'." (or (>= (- (point) (overlay-end rfn-eshadow-overlay)) 2) (eq ?/ (char-before (- (point) 2))))) (delete-region (overlay-start rfn-eshadow-overlay) - (overlay-end rfn-eshadow-overlay)) ) + (overlay-end rfn-eshadow-overlay))) (let* ((field-string (icomplete--field-string)) ;; Not sure why, but such requests seem to come ;; every once in a while. It's not fully From e948cdbfa8508c7fc98a39caaf5e46798e6a3939 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 14 Dec 2020 10:52:05 +0200 Subject: [PATCH 047/148] Allow creating a new tab for tab-switcher from the minibuffer (bug#45072) * lisp/tab-bar.el (tab-switcher): Simplify by let-binding tab-bar-new-tab-choice to t before calling tab-bar-new-tab that handles the case when it's called in the active minibuffer. --- lisp/tab-bar.el | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 1327bde9088..3a705aa015d 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -762,6 +762,7 @@ After the tab is created, the hooks in (from-tab (tab-bar--tab))) (when tab-bar-new-tab-choice + ;; Handle the case when it's called in the active minibuffer. (when (minibuffer-selected-window) (select-window (minibuffer-selected-window))) (delete-other-windows) @@ -1200,18 +1201,11 @@ Type q to remove the list of window configurations from the display. The first column shows `D' for a window configuration you have marked for deletion." (interactive) - (let ((dir default-directory) - (minibuf (minibuffer-selected-window))) - (let ((tab-bar-show nil)) ; don't enable tab-bar-mode if it's disabled + (let ((dir default-directory)) + (let ((tab-bar-new-tab-choice t) + ;; Don't enable tab-bar-mode if it's disabled + (tab-bar-show nil)) (tab-bar-new-tab)) - ;; Handle the case when it's called in the active minibuffer. - (when minibuf (select-window (minibuffer-selected-window))) - (delete-other-windows) - ;; Create a new window to replace the existing one, to not break the - ;; window parameters (e.g. prev/next buffers) of the window just saved - ;; to the window configuration. So when a saved window is restored, - ;; its parameters left intact. - (split-window) (delete-window) (let ((switch-to-buffer-preserve-window-point nil)) (switch-to-buffer (tab-switcher-noselect))) (setq default-directory dir)) From c6c4e746036c5ba714bfce565de13d713f3cb8b5 Mon Sep 17 00:00:00 2001 From: Gabriel do Nascimento Ribeiro Date: Sun, 13 Dec 2020 15:35:46 -0300 Subject: [PATCH 048/148] New option tab-bar-history-buttons-show * lisp/tab-bar.el (tab-bar-history-buttons-show): If true, show back and forward buttons when tab-bar-history-mode is enabled. (Bug#45227) Copyright-paperwork-exempt: yes --- lisp/tab-bar.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 3a705aa015d..9506b1b22ea 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -296,6 +296,16 @@ If nil, don't show it at all." (defvar tab-bar-forward-button " > " "Button for going forward in tab history.") +(defcustom tab-bar-history-buttons-show t + "Show back and forward buttons when `tab-bar-history-mode' is enabled." + :type 'boolean + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (force-mode-line-update)) + :group 'tab-bar + :version "28.1") + (defcustom tab-bar-tab-hints nil "Show absolute numbers on tabs in the tab bar before the tab name. This helps to select the tab by its number using `tab-bar-select-tab' @@ -415,7 +425,7 @@ Return its existing value or a new value." (tabs (funcall tab-bar-tabs-function))) (append '(keymap (mouse-1 . tab-bar-handle-mouse)) - (when tab-bar-history-mode + (when (and tab-bar-history-mode tab-bar-history-buttons-show) `((sep-history-back menu-item ,separator ignore) (history-back menu-item ,tab-bar-back-button tab-bar-history-back From cc5f2803785c5dc785f09a292313cf799e8d29bb Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:39:10 +0100 Subject: [PATCH 049/148] * lisp/net/dictionary.el: Add lexical-binding:t Fixing all the issues found by this. A number of unused variables were reported here. --- lisp/net/dictionary.el | 39 ++++++++++++++++++--------------------- 1 file changed, 18 insertions(+), 21 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 6eb8475f55d..65ed7d2b1e2 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1,4 +1,4 @@ -;;; dictionary.el --- Client for rfc2229 dictionary servers +;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*- ;; Author: Torsten Hilbrich ;; Keywords: interface, dictionary @@ -416,7 +416,7 @@ is utf-8" (dictionary-store-positions) (dictionary-store-state 'dictionary-new-buffer nil))) -(defun dictionary-new-buffer (&rest ignore) +(defun dictionary-new-buffer () "Create a new and clean buffer" (dictionary-pre-buffer) @@ -513,7 +513,7 @@ is utf-8" ;; Dealing with closing the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun dictionary-close (&rest ignore) +(defun dictionary-close () "Close the current dictionary buffer and its connection" (interactive) (if (eq major-mode 'dictionary-mode) @@ -777,13 +777,13 @@ This function knows about the special meaning of quotes (\")" (dictionary (nth 2 reply-list)) (description (nth 3 reply-list)) (word (nth 1 reply-list))) - (dictionary-display-word-entry word dictionary description) + (dictionary-display-word-entry dictionary description) (setq reply (dictionary-read-answer)) (dictionary-display-word-definition reply word dictionary) (setq reply (dictionary-read-reply-and-split)))) (dictionary-post-buffer))) -(defun dictionary-display-word-entry (word dictionary description) +(defun dictionary-display-word-entry (dictionary description) "Insert an explanation for the current definition." (let ((start (point))) (insert "From " @@ -857,7 +857,7 @@ The word is taken from the buffer, the `dictionary' is given as argument." (unless (dictionary-check-reply reply 110) (error "Unknown server answer: %s" (dictionary-reply reply))) - (dictionary-display-dictionarys reply)))) + (dictionary-display-dictionarys)))) (defun dictionary-simple-split-string (string &optional pattern) "Return a list of substrings of STRING which are separated by PATTERN. @@ -872,7 +872,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." start (match-end 0))) (nreverse (cons (substring string start) parts)))) -(defun dictionary-display-dictionarys (reply) +(defun dictionary-display-dictionarys () "Handle the display of all dictionaries existing on the server" (dictionary-pre-buffer) (insert "Please select your default dictionary:\n\n") @@ -969,9 +969,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (unless (dictionary-check-reply reply 111) (error "Unknown server answer: %s" (dictionary-reply reply))) - (dictionary-display-strategies reply)))) + (dictionary-display-strategies)))) -(defun dictionary-display-strategies (reply) +(defun dictionary-display-strategies () "Handle the display of all strategies existing on the server" (dictionary-pre-buffer) (insert "Please select your default search strategy:\n\n") @@ -1186,9 +1186,8 @@ It presents the word at point as default input and allows editing it." dictionary-default-popup-strategy 'dictionary-process-popup-replies)) -(defun dictionary-process-popup-replies (reply) - (let ((number (nth 1 (dictionary-reply-list reply))) - (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) +(defun dictionary-process-popup-replies (&ignore) + (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (let ((result (mapcar (lambda (item) (let* ((list (dictionary-split-string item)) @@ -1204,13 +1203,11 @@ It presents the word at point as default input and allows editing it." t )))) list))) - (let ((menu (make-sparse-keymap 'dictionary-popup))) - - (easy-menu-define dictionary-mode-map-menu dictionary-mode-map - "Menu used for displaying dictionary popup" - (cons "Matching words" - `(,@result))) - (popup-menu dictionary-mode-map-menu))))) + (easy-menu-define dictionary-mode-map-menu dictionary-mode-map + "Menu used for displaying dictionary popup" + (cons "Matching words" + `(,@result))) + (popup-menu dictionary-mode-map-menu)))) ;;; Tooltip support @@ -1234,7 +1231,7 @@ It presents the word at point as default input and allows editing it." (dictionary-do-search word dictionary 'dictionary-read-definition t)) nil)) -(defun dictionary-read-definition (reply) +(defun dictionary-read-definition (&ignore) (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (mapconcat 'identity (cdr list) "\n"))) @@ -1255,7 +1252,7 @@ It presents the word at point as default input and allows editing it." (defvar dictionary-tooltip-mouse-event nil "Event that triggered the tooltip mode") -(defun dictionary-display-tooltip (event) +(defun dictionary-display-tooltip (&ignore) "Search the current word in the `dictionary-tooltip-dictionary'." (interactive "e") (if (and dictionary-tooltip-mode dictionary-tooltip-dictionary) From 09952ce43451b76a0f7839e35d033fbbfa078e31 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:40:45 +0100 Subject: [PATCH 050/148] Removed useless check for popup-menu * lisp/net/dictionary.el (dictionary-popup-matching-words): No need to check for popup-menu, the code is part of Emacs now and the function should always be there --- lisp/net/dictionary.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 65ed7d2b1e2..12b11cb5111 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1179,8 +1179,6 @@ It presents the word at point as default input and allows editing it." (defun dictionary-popup-matching-words (&optional word) "Display entries matching the word at the point" (interactive) - (unless (functionp 'popup-menu) - (error "Sorry, popup menus are not available in this emacs version")) (dictionary-do-matching (or word (current-word)) dictionary-default-dictionary dictionary-default-popup-strategy From 81ebe86d8deace5cc39979a42dcf062bdaa830c4 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:45:25 +0100 Subject: [PATCH 051/148] Show error message when asking to match for nothing * lisp/net/dictionary.el (dictionary-popup-matching-words): Show error if neither the parameter nor the word at point are defined This avoids an error later on when the nil value is used as string within dictionary-encode-charset. --- lisp/net/dictionary.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 12b11cb5111..d910dab1600 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1179,7 +1179,7 @@ It presents the word at point as default input and allows editing it." (defun dictionary-popup-matching-words (&optional word) "Display entries matching the word at the point" (interactive) - (dictionary-do-matching (or word (current-word)) + (dictionary-do-matching (or word (current-word) (error "Nothing to search for")) dictionary-default-dictionary dictionary-default-popup-strategy 'dictionary-process-popup-replies)) From 0044a2e888a62eea6dd8e6ead5aeffec965bf3a3 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:48:29 +0100 Subject: [PATCH 052/148] * lisp/net/dictionary-connection.el: Add lexical-binding:t --- lisp/net/dictionary-connection.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index f1d11bf3c57..d433fb3fec8 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -1,4 +1,4 @@ -;;; dictionary-connection.el --- TCP-based client connection for dictionary +;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*- ;; Author: Torsten Hilbrich ;; Keywords: network From f58443780cec26bad578309ae7c801baaa1b07db Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:49:18 +0100 Subject: [PATCH 053/148] * lisp/net/dictionary-connection.el: Remove obsolete Version --- lisp/net/dictionary-connection.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index d433fb3fec8..a5c36e65b4a 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -2,7 +2,6 @@ ;; Author: Torsten Hilbrich ;; Keywords: network -;; Version: 1.11 ;; 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 From 54a3964e290d277df1e510c8829ede926aac23b2 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Thu, 19 Nov 2020 21:50:50 +0100 Subject: [PATCH 054/148] Update GPL version * lisp/net/dictionary.el: Use GPL version 3 or later * lisp/net/dictionary-connection.el: Use GPL version 3 or later --- lisp/net/dictionary-connection.el | 2 +- lisp/net/dictionary.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index a5c36e65b4a..f8a667991aa 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -5,7 +5,7 @@ ;; 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 -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index d910dab1600..624c1a40f55 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -5,7 +5,7 @@ ;; 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 -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, From a557a103cc576c97a82346760a84947fe296000c Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 09:31:28 +0100 Subject: [PATCH 055/148] * lisp/net/dictionary-connection.el: Prefer defsubst Use defsubst instead of defmacro here. It was suggested by Stefan Kangas to replace the defmacro here and, looking at the lispref, defsubst seems to be a suitable replacement providing the same benefit of inlining functionality as the defmacro. --- lisp/net/dictionary-connection.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index f8a667991aa..c762b352b75 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -27,33 +27,33 @@ ;;; Code: -(defmacro dictionary-connection-p (connection) +(defsubst dictionary-connection-p (connection) "Returns non-nil if `connection' is a connection object" - (list 'get connection ''connection)) + (get connection 'connection)) -(defmacro dictionary-connection-read-point (connection) +(defsubst dictionary-connection-read-point (connection) "Return the read point of the connection object." - (list 'get connection ''dictionary-connection-read-point)) + (get connection 'dictionary-connection-read-point)) -(defmacro dictionary-connection-process (connection) +(defsubst dictionary-connection-process (connection) "Return the process of the connection object." - (list 'get connection ''dictionary-connection-process)) + (get connection 'dictionary-connection-process)) -(defmacro dictionary-connection-buffer (connection) +(defsubst dictionary-connection-buffer (connection) "Return the buffer of the connection object." - (list 'get connection ''dictionary-connection-buffer)) + (get connection 'dictionary-connection-buffer)) -(defmacro dictionary-connection-set-read-point (connection point) +(defsubst dictionary-connection-set-read-point (connection point) "Set the read-point for `connection' to `point'." - (list 'put connection ''dictionary-connection-read-point point)) + (put connection 'dictionary-connection-read-point point)) -(defmacro dictionary-connection-set-process (connection process) +(defsubst dictionary-connection-set-process (connection process) "Set the process for `connection' to `process'." - (list 'put connection ''dictionary-connection-process process)) + (put connection 'dictionary-connection-process process)) -(defmacro dictionary-connection-set-buffer (connection buffer) +(defsubst dictionary-connection-set-buffer (connection buffer) "Set the buffer for `connection' to `buffer'." - (list 'put connection ''dictionary-connection-buffer buffer)) + (put connection 'dictionary-connection-buffer buffer)) (defun dictionary-connection-create-data (buffer process point) "Create a new connection data based on `buffer', `process', and `point'." From ffa7d6671d893de397cb17c7230f68ef46bef294 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 09:34:44 +0100 Subject: [PATCH 056/148] * lisp/net/dictionary.el: Prefer defsubst over defmacro --- lisp/net/dictionary.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 624c1a40f55..782282c27cd 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -422,17 +422,17 @@ is utf-8" (dictionary-pre-buffer) (dictionary-post-buffer)) -(defmacro dictionary-reply-code (reply) +(defsubst dictionary-reply-code (reply) "Return the reply code stored in `reply'." - (list 'get reply ''reply-code)) + (get reply 'reply-code)) -(defmacro dictionary-reply (reply) +(defsubst dictionary-reply (reply) "Return the string reply stored in `reply'." - (list 'get reply ''reply)) + (get reply 'reply)) -(defmacro dictionary-reply-list (reply) +(defsubst dictionary-reply-list (reply) "Return the reply list stored in `reply'." - (list 'get reply ''reply-list)) + (get reply 'reply-list)) (defun dictionary-open-server (server) "Opens a new connection to this server" From 4deb8618e4ab568c01da7c839dff4f29710a3298 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 09:40:33 +0100 Subject: [PATCH 057/148] * lisp/net/dictionary.el (dictionary-mode): Use setq-local --- lisp/net/dictionary.el | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 782282c27cd..1596e11ce47 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -380,10 +380,8 @@ is utf-8" (setq major-mode 'dictionary-mode) (setq mode-name "Dictionary") - (make-local-variable 'dictionary-data-stack) - (setq dictionary-data-stack nil) - (make-local-variable 'dictionary-position-stack) - (setq dictionary-position-stack nil) + (setq-local dictionary-data-stack nil) + (setq-local dictionary-position-stack nil) (make-local-variable 'dictionary-current-data) (make-local-variable 'dictionary-positions) @@ -407,10 +405,8 @@ is utf-8" (switch-to-buffer-other-window buffer) (dictionary-mode) - (make-local-variable 'dictionary-window-configuration) - (make-local-variable 'dictionary-selected-window) - (setq dictionary-window-configuration window-configuration) - (setq dictionary-selected-window selected-window) + (setq-local dictionary-window-configuration window-configuration) + (setq-local dictionary-selected-window selected-window) (dictionary-check-connection) (dictionary-new-buffer) (dictionary-store-positions) From d30618cbc11fb33a0d55c54200eb45f39251189c Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 09:40:33 +0100 Subject: [PATCH 058/148] * lisp/net/dictionary.el (dictionary-tooltip-mode): Use setq-local --- lisp/net/dictionary.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1596e11ce47..afa4d393c0d 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1297,11 +1297,9 @@ overwrite that mode for the current buffer. (let ((on (if arg (> (prefix-numeric-value arg) 0) (not dictionary-tooltip-mode)))) - (make-local-variable 'dictionary-tooltip-mode) - (setq dictionary-tooltip-mode on) - (make-local-variable 'track-mouse) + (setq-local dictionary-tooltip-mode on) + (setq-local track-mouse on) (make-local-variable 'dictionary-tooltip-mouse-event) - (setq track-mouse on) (dictionary-switch-tooltip-mode 1) (if on (local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse) From a25a12ddaf61389030a1afaa535d5563856cfc70 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 09:48:26 +0100 Subject: [PATCH 059/148] Use when where else case returns nil * lisp/net/dictionary-connection.el (dictionary-connection-status, dictionary-connection-close): Instead of returning nil in the else case of the if just use when. Was suggested by Stefan Kangas. --- lisp/net/dictionary-connection.el | 40 +++++++++++++++---------------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index c762b352b75..0d93d978df3 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -85,31 +85,29 @@ nil: argument is no connection object 'up: connection is open and buffer is existing 'down: connection is closed 'alone: connection is not associated with a buffer" - (if (dictionary-connection-p connection) - (let ((process (dictionary-connection-process connection)) - (buffer (dictionary-connection-buffer connection))) - (if (not process) - 'none - (if (not (buffer-live-p buffer)) - 'alone - (if (not (eq (process-status process) 'open)) - 'down - 'up)))) - nil)) + (when (dictionary-connection-p connection) + (let ((process (dictionary-connection-process connection)) + (buffer (dictionary-connection-buffer connection))) + (if (not process) + 'none + (if (not (buffer-live-p buffer)) + 'alone + (if (not (eq (process-status process) 'open)) + 'down + 'up)))))) (defun dictionary-connection-close (connection) "Force closing of the connection." - (if (dictionary-connection-p connection) - (progn - (let ((buffer (dictionary-connection-buffer connection)) - (process (dictionary-connection-process connection))) - (if process - (delete-process process)) - (if buffer - (kill-buffer buffer)) + (when (dictionary-connection-p connection) + (let ((buffer (dictionary-connection-buffer connection)) + (process (dictionary-connection-process connection))) + (if process + (delete-process process)) + (if buffer + (kill-buffer buffer)) - (dictionary-connection-set-process connection nil) - (dictionary-connection-set-buffer connection nil))))) + (dictionary-connection-set-process connection nil) + (dictionary-connection-set-buffer connection nil)))) (defun dictionary-connection-send (connection data) "Send `data' to the process." From 89e9c1686e99c2b6369f6aa858ed3a347b940c4f Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 09:52:23 +0100 Subject: [PATCH 060/148] * lisp/net/dictionary.el (dictionary-display-more-info): Spelling fix Fix the spelling in the error message for non-existing dictionary. --- lisp/net/dictionary.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index afa4d393c0d..1ac6c6838b1 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -928,7 +928,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (let ((reply (dictionary-read-reply-and-split))) (message nil) (if (dictionary-check-reply reply 550) - (error "Dictionary \"%s\" not existing" dictionary) + (error "Dictionary \"%s\" does not exist" dictionary) (unless (dictionary-check-reply reply 112) (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) From d466231c3e3fca3e9f1b772ca9417a038d05d982 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 10:55:35 +0100 Subject: [PATCH 061/148] A number of docstring fixes * lisp/net/dictionary.el (dictionary-set-server-var, dictionary-mode, dictionary, dictionary-new-buffer, dictionary-reply-code, dictionary-reply, dictionary-reply-list, dictionary-open-server, dictionary-check-connection, dictionary-mode-p, dictionary-close, dictionary-read-reply, dictionary-split-string, dictionary-read-reply-and-split, dictionary-read-answer, dictionary-check-reply, dictionary-coding-system, dictionary-decode-charset, dictionary-encode-charset, dictionary-check-initial-reply, dictionary-store-state, dictionary-restore-state, dictionary-new-search, dictionary-new-search-internal, dictionary-do-search, dictionary-pre-buffer, dictionary-post-buffer, dictionary-display-search-result, dictionary-display-word-entry, dictionary-display-word-definition, dictionary-mark-reference, dictionary-select-dictionary, dictionary-display-dictionarys, dictionary-display-dictionary-line, dictionary-set-dictionary, dictionary-special-dictionary, dictionary-display-more-info, dictionary-select-strategy, dictionary-do-select-strategy, dictionary-display-strategies, dictionary-display-strategy-line, dictionary-set-strategy, dictionary-new-matching, dictionary-do-matching, dictionary-display-only-match-result, dictionary-display-match-result, dictionary-display-match-result, dictionary-display-match-lines, dictionary-search, dictionary-previous, dictionary-help, dictionary-match-words, dictionary-mouse-popup-matching-words, dictionary-popup-matching-words, dictionary-tooltip-mode, dictionary-tooltip-mouse-event): Fix docstring The following kind of changes were made: - finish first line with a full stop (.) - mention parameter in upper-case whenever possible (considering the length constraints) --- lisp/net/dictionary.el | 163 +++++++++++++++++++++++------------------ 1 file changed, 92 insertions(+), 71 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1ac6c6838b1..f06efaea375 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -44,6 +44,10 @@ (defvar dictionary-current-server) (defun dictionary-set-server-var (name value) + "Customize helper for setting variable NAME to VALUE. +The helper is used by customize to check for an active connection +when setting a variable. The user has then the choice to close +the existing connection." (if (and (boundp 'dictionary-connection) dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up) @@ -352,24 +356,25 @@ is utf-8" ;;;###autoload (defun dictionary-mode () - "This is a mode for searching a dictionary server implementing - the protocol defined in RFC 2229. + "Mode for searching a dictionary. +This is a mode for searching a dictionary server implementing the +protocol defined in RFC 2229. - This is a quick reference to this mode describing the default key bindings: +This is a quick reference to this mode describing the default key bindings: - * q close the dictionary buffer - * h display this help information - * s ask for a new word to search - * d search the word at point - * n or Tab place point to the next link - * p or S-Tab place point to the prev link +* q close the dictionary buffer +* h display this help information +* s ask for a new word to search +* d search the word at point +* n or Tab place point to the next link +* p or S-Tab place point to the prev link - * m ask for a pattern and list all matching words. - * D select the default dictionary - * M select the default search strategy +* m ask for a pattern and list all matching words. +* D select the default dictionary +* M select the default search strategy - * Return or Button2 visit that link - " +* Return or Button2 visit that link +" (unless (eq major-mode 'dictionary-mode) (cl-incf dictionary-instances)) @@ -394,7 +399,7 @@ is utf-8" ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install dictionary-mode" + "Create a new dictonary buffer and install dictionary-mode." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -413,25 +418,27 @@ is utf-8" (dictionary-store-state 'dictionary-new-buffer nil))) (defun dictionary-new-buffer () - "Create a new and clean buffer" + "Create a new and clean buffer." (dictionary-pre-buffer) (dictionary-post-buffer)) (defsubst dictionary-reply-code (reply) - "Return the reply code stored in `reply'." + "Return the reply code stored in REPLY." (get reply 'reply-code)) (defsubst dictionary-reply (reply) - "Return the string reply stored in `reply'." + "Return the string reply stored in REPLY." (get reply 'reply)) (defsubst dictionary-reply-list (reply) - "Return the reply list stored in `reply'." + "Return the reply list stored in REPLY." (get reply 'reply-list)) (defun dictionary-open-server (server) - "Opens a new connection to this server" + "Opens a new connection to SERVER. +The connection takes the proxy setting in customization group +`dictionary-proxy' into account." (let ((wanted 'raw-text) (coding-system nil)) (if (member wanted (coding-system-list)) @@ -481,7 +488,7 @@ is utf-8" (dictionary-reply reply))))))) (defun dictionary-check-connection () - "Check if there is already a connection open" + "Check if there is already a connection open." (if (not (and dictionary-connection (eq (dictionary-connection-status dictionary-connection) 'up))) (if dictionary-server @@ -497,7 +504,7 @@ is utf-8" (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () - "Return non-nil if current buffer has dictionary-mode" + "Return non-nil if current buffer has dictionary-mode." (eq major-mode 'dictionary-mode)) (defun dictionary-ensure-buffer () @@ -510,7 +517,7 @@ is utf-8" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-close () - "Close the current dictionary buffer and its connection" + "Close the current dictionary buffer and its connection." (interactive) (if (eq major-mode 'dictionary-mode) (progn @@ -534,14 +541,14 @@ is utf-8" (dictionary-connection-send-crlf dictionary-connection string)) (defun dictionary-read-reply () - "Read the reply line from the server" + "Read the reply line from the server." (let ((answer (dictionary-connection-read-crlf dictionary-connection))) (if (string-match "\r?\n" answer) (substring answer 0 (match-beginning 0)) answer))) (defun dictionary-split-string (string) - "Split the `string' constiting of space separated words into elements. + "Split STRING constiting of space-separated words into elements. This function knows about the special meaning of quotes (\")" (let ((list)) (while (and string (> (length string) 0)) @@ -559,7 +566,7 @@ This function knows about the special meaning of quotes (\")" (nreverse list))) (defun dictionary-read-reply-and-split () - "Read the reply, split it into words and return it" + "Reads the reply, splits it into words and returns it." (let ((answer (make-symbol "reply-data")) (reply (dictionary-read-reply))) (let ((reply-list (dictionary-split-string reply))) @@ -569,7 +576,8 @@ This function knows about the special meaning of quotes (\")" answer))) (defun dictionary-read-answer () - "Read an answer delimited by a . on a single line" + "Read the complete answer. +The answer is delimited by a decimal point (.) on a line by itself." (let ((answer (dictionary-connection-read-to-point dictionary-connection)) (start 0)) (while (string-match "\r\n" answer start) @@ -581,13 +589,13 @@ This function knows about the special meaning of quotes (\")" answer)) (defun dictionary-check-reply (reply code) - "Check if the reply in `reply' has the `code'." + "Extract the reply code from REPLY and checks against CODE." (let ((number (dictionary-reply-code reply))) (and (numberp number) (= number code)))) (defun dictionary-coding-system (dictionary) - "Select coding system to use for that dictionary" + "Select coding system to use for DICTIONARY." (let ((coding-system (or (cdr (assoc dictionary dictionary-coding-systems-for-dictionaries)) @@ -597,14 +605,14 @@ This function knows about the special meaning of quotes (\")" nil))) (defun dictionary-decode-charset (text dictionary) - "Convert the text from the charset defined by the dictionary given." + "Convert TEXT from the charset configured for DICTIONARY." (let ((coding-system (dictionary-coding-system dictionary))) (if coding-system (decode-coding-string text coding-system) text))) (defun dictionary-encode-charset (text dictionary) - "Convert the text to the charset defined by the dictionary given." + "Convert TEXT to the charset defined for DICTIONARY." (let ((coding-system (dictionary-coding-system dictionary))) (if coding-system (encode-coding-string text coding-system) @@ -615,7 +623,7 @@ This function knows about the special meaning of quotes (\")" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-check-initial-reply () - "Read the first reply from server and check it." + "Reads the first reply from server and checks it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) (dictionary-connection-close dictionary-connection) @@ -623,8 +631,10 @@ This function knows about the special meaning of quotes (\")" ;; Store the current state (defun dictionary-store-state (function data) - "Stores the current state of operation for later restore." - + "Stores the current state of operation for later restore. +The current state consist of a tuple of FUNCTION and DATA. This +is basically an implementation of a history to return to a +previous state." (if dictionary-current-data (progn (push dictionary-current-data dictionary-data-stack) @@ -641,7 +651,7 @@ This function knows about the special meaning of quotes (\")" ;; Restore the previous state (defun dictionary-restore-state (&rest ignored) - "Restore the state just before the last operation" + "Restore the state just before the last operation." (let ((position (pop dictionary-position-stack)) (data (pop dictionary-data-stack))) (unless position @@ -654,7 +664,9 @@ This function knows about the special meaning of quotes (\")" ;; The normal search (defun dictionary-new-search (args &optional all) - "Save the current state and start a new search" + "Saves the current state and starts a new search based on ARGS. +The parameter ARGS is a cons cell where car is the word to search +and cdr is the dictionary where to search the word in." (interactive) (dictionary-store-positions) (let ((word (car args)) @@ -668,12 +680,16 @@ This function knows about the special meaning of quotes (\")" (list word dictionary 'dictionary-display-search-result)))) (defun dictionary-new-search-internal (word dictionary function) - "Starts a new search after preparing the buffer" + "Starts a new search for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result. +" (dictionary-pre-buffer) (dictionary-do-search word dictionary function)) (defun dictionary-do-search (word dictionary function &optional nomatching) - "The workhorse for doing the search" + "Searches WORD in DICTIONARY and calls FUNCTION for each result. +The parameter NOMATCHING controls whether to suppress the display +of matching words." (message "Searching for %s in %s" word dictionary) (dictionary-send-command (concat "define " @@ -717,7 +733,7 @@ This function knows about the special meaning of quotes (\")" 'face 'dictionary-button-face) (defun dictionary-pre-buffer () - "These commands are executed at the begin of a new buffer" + "These commands are executed at the begin of a new buffer." (setq buffer-read-only nil) (erase-buffer) (if dictionary-create-buttons @@ -753,14 +769,14 @@ This function knows about the special meaning of quotes (\")" (setq dictionary-marker (point-marker))) (defun dictionary-post-buffer () - "These commands are executed at the end of a new buffer" + "These commands are executed at the end of a new buffer." (goto-char dictionary-marker) (set-buffer-modified-p nil) (setq buffer-read-only t)) (defun dictionary-display-search-result (reply) - "This function starts displaying the result starting with the `reply'." + "This function starts displaying the result in REPLY." (let ((number (nth 1 (dictionary-reply-list reply)))) (insert number (if (equal number "1") @@ -780,7 +796,8 @@ This function knows about the special meaning of quotes (\")" (dictionary-post-buffer))) (defun dictionary-display-word-entry (dictionary description) - "Insert an explanation for the current definition." + "Insert an explanation for DESCRIPTION from DICTIONARY. +The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION." (let ((start (point))) (insert "From " dictionary-description-open-delimiter @@ -791,7 +808,10 @@ This function knows about the special meaning of quotes (\")" (insert "\n\n"))) (defun dictionary-display-word-definition (reply word dictionary) - "Insert the definition for the current word" + "Insert the definition in REPLY for the current WORD from DICTIONARY. +It will replace links which are found in the REPLY and replace +them with buttons to perform a a new search. +" (let ((start (point))) (insert (dictionary-decode-charset reply dictionary)) (insert "\n\n") @@ -817,8 +837,8 @@ This function knows about the special meaning of quotes (\")" (goto-char (point-max))))))) (defun dictionary-mark-reference (start end call displayed-word dictionary) - "Format the area from `start' to `end' as link calling `call'. -The word is taken from the buffer, the `dictionary' is given as argument." + "Format the area from START to END as link calling CALL. +The word is taken from the buffer, the DICTIONARY is given as argument." (let ((word (buffer-substring-no-properties start end))) (while (string-match "\n\\s-*" word) (setq word (replace-match " " t t word))) @@ -833,7 +853,7 @@ The word is taken from the buffer, the `dictionary' is given as argument." word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) - "Save the current state and start a dictionary selection" + "Save the current state and start a dictionary selection." (interactive) (dictionary-ensure-buffer) (dictionary-store-positions) @@ -869,7 +889,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (nreverse (cons (substring string start) parts)))) (defun dictionary-display-dictionarys () - "Handle the display of all dictionaries existing on the server" + "Handle the display of all dictionaries existing on the server." (dictionary-pre-buffer) (insert "Please select your default dictionary:\n\n") (dictionary-display-dictionary-line "* \"All dictionaries\"") @@ -880,7 +900,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-post-buffer)) (defun dictionary-display-dictionary-line (string) - "Display a single dictionary" + "Display a single dictionary and its description read from STRING." (let* ((list (dictionary-split-string string)) (dictionary (car list)) (description (cadr list)) @@ -901,7 +921,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) - "Select this dictionary as new default" + "Select the dictionary which is the car of PARAM as new default." (if more (dictionary-display-more-info param) @@ -911,12 +931,12 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (message "Dictionary %s has been selected" dictionary)))) (defun dictionary-special-dictionary (name) - "Checks whether the special * or ! dictionary are seen" + "Checks whether the special * or ! dictionary are seen in NAME." (or (equal name "*") (equal name "!"))) (defun dictionary-display-more-info (param) - "Display the available information on the dictionary" + "Display the available information on the dictionary found in PARAM." (let ((dictionary (car param)) (description (cdr param))) @@ -945,7 +965,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-store-state 'dictionary-display-more-info dictionary)))) (defun dictionary-select-strategy (&rest ignored) - "Save the current state and start a strategy selection" + "Save the current state and start a strategy selection." (interactive) (dictionary-ensure-buffer) (dictionary-store-positions) @@ -968,7 +988,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-display-strategies)))) (defun dictionary-display-strategies () - "Handle the display of all strategies existing on the server" + "Handle the display of all strategies existing on the server." (dictionary-pre-buffer) (insert "Please select your default search strategy:\n\n") (dictionary-display-strategy-line ". \"The servers default\"") @@ -978,7 +998,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-post-buffer)) (defun dictionary-display-strategy-line (string) - "Display a single strategy" + "Display a single strategy found in STRING." (let* ((list (dictionary-split-string string)) (strategy (car list)) (description (cadr list))) @@ -991,13 +1011,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) - "Select this strategy as new default" + "Select this STRATEGY as new default" (setq dictionary-default-strategy strategy) (dictionary-restore-state) (message "Strategy %s has been selected" strategy)) (defun dictionary-new-matching (word) - "Run a new matching search on `word'." + "Run a new matching search on WORD." (dictionary-ensure-buffer) (dictionary-store-positions) (dictionary-do-matching word dictionary-default-dictionary @@ -1009,7 +1029,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." 'dictionary-display-match-result))) (defun dictionary-do-matching (word dictionary strategy function) - "Ask the server about matches to `word' and display it." + "Find matches for WORD with STRATEGY in DICTIONARY and displays them with FUNCTION." (message "Lookup matching words for %s in %s using %s" word dictionary strategy) @@ -1033,7 +1053,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (funcall function reply))) (defun dictionary-display-only-match-result (reply) - "Display the results from the current matches without the headers." + "Display the results from the current matches in REPLY without the headers." (let ((number (nth 1 (dictionary-reply-list reply))) (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) @@ -1055,7 +1075,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-display-match-lines (reverse result))))) (defun dictionary-display-match-result (reply) - "Display the results from the current matches." + "Display the results in REPLY from a match operation." (dictionary-pre-buffer) (let ((number (nth 1 (dictionary-reply-list reply))) @@ -1079,7 +1099,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (dictionary-post-buffer)) (defun dictionary-display-match-lines (list) - "Display the match lines." + "Display a line for each match found in LIST." (mapc (lambda (item) (let ((dictionary (car item)) (word-list (cdr item))) @@ -1109,8 +1129,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." ;;;###autoload (defun dictionary-search (word &optional dictionary) - "Search the `word' in `dictionary' if given or in all if nil. -It presents the word at point as default input and allows editing it." + "Search the WORD in DICTIONARY if given or in all if nil. +It presents the selection or word at point as default input and +allows editing it." (interactive (list (let ((default (dictionary-search-default))) (read-string (if default @@ -1139,20 +1160,20 @@ It presents the word at point as default input and allows editing it." (dictionary-new-search (cons (current-word) dictionary-default-dictionary))) (defun dictionary-previous () - "Go to the previous location in the current buffer" + "Go to the previous location in the current buffer." (interactive) (unless (dictionary-mode-p) (error "Current buffer is no dictionary buffer")) (dictionary-restore-state)) (defun dictionary-help () - "Display a little help" + "Display a little help." (interactive) (describe-function 'dictionary-mode)) ;;;###autoload (defun dictionary-match-words (&optional pattern &rest ignored) - "Search `pattern' in current default dictionary using default strategy." + "Search PATTERN in current default dictionary using default strategy." (interactive) ;; can't use interactive because of mouse events (or pattern @@ -1162,7 +1183,7 @@ It presents the word at point as default input and allows editing it." ;;;###autoload (defun dictionary-mouse-popup-matching-words (event) - "Display entries matching the word at the cursor" + "Display entries matching the word at the cursor retrieved using EVENT." (interactive "e") (let ((word (save-window-excursion (save-excursion @@ -1173,7 +1194,7 @@ It presents the word at point as default input and allows editing it." ;;;###autoload (defun dictionary-popup-matching-words (&optional word) - "Display entries matching the word at the point" + "Display entries matching WORD or the current word if not given." (interactive) (dictionary-do-matching (or word (current-word) (error "Nothing to search for")) dictionary-default-dictionary @@ -1208,7 +1229,7 @@ It presents the word at point as default input and allows editing it." ;; Add a mode indicater named "Dict" (defvar dictionary-tooltip-mode nil - "Indicates wheather the dictionary tooltip mode is active") + "Indicates wheather the dictionary tooltip mode is active.") (nconc minor-mode-alist '((dictionary-tooltip-mode " Dict"))) (defcustom dictionary-tooltip-dictionary @@ -1244,7 +1265,7 @@ It presents the word at point as default input and allows editing it." (current-word)))))) (defvar dictionary-tooltip-mouse-event nil - "Event that triggered the tooltip mode") + "Event that triggered the tooltip mode.") (defun dictionary-display-tooltip (&ignore) "Search the current word in the `dictionary-tooltip-dictionary'." @@ -1288,8 +1309,8 @@ will be set to nil. "Display tooltips for the current word. This function can be used to enable or disable the tooltip mode -for the current buffer. If global-tooltip-mode is active it will -overwrite that mode for the current buffer. +for the current buffer (based on ARG). If global-tooltip-mode is +active it will overwrite that mode for the current buffer. " (interactive "P") From b18217eb870c45b0a49d29f2f96e67b5554fc4fb Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 11:09:22 +0100 Subject: [PATCH 062/148] A number of docstring fixes * lisp/net/dictionary-connection.el (dictionary-connection-p, dictionary-connection-read-point, dictionary-connection-process, dictionary-connection-buffer, dictionary-connection-set-read-point, dictionary-connection-set-process, dictionary-connection-set-buffer, dictionary-connection-create-data, dictionary-connection-open, dictionary-connection-status, dictionary-connection-close, dictionary-connection-send, dictionary-connection-send-crlf, dictionary-connection-read, dictionary-connection-read-crlf, dictionary-connection-read-to-point): Fix docstring --- lisp/net/dictionary-connection.el | 34 ++++++++++++++++--------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 0d93d978df3..d88c0b48f93 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -28,35 +28,35 @@ ;;; Code: (defsubst dictionary-connection-p (connection) - "Returns non-nil if `connection' is a connection object" + "Returns non-nil if CONNECTION is a connection object." (get connection 'connection)) (defsubst dictionary-connection-read-point (connection) - "Return the read point of the connection object." + "Return the read point of the CONNECTION object." (get connection 'dictionary-connection-read-point)) (defsubst dictionary-connection-process (connection) - "Return the process of the connection object." + "Return the process of the CONNECTION object." (get connection 'dictionary-connection-process)) (defsubst dictionary-connection-buffer (connection) - "Return the buffer of the connection object." + "Return the buffer of the CONNECTION object." (get connection 'dictionary-connection-buffer)) (defsubst dictionary-connection-set-read-point (connection point) - "Set the read-point for `connection' to `point'." + "Set the read-point for CONNECTION to POINT." (put connection 'dictionary-connection-read-point point)) (defsubst dictionary-connection-set-process (connection process) - "Set the process for `connection' to `process'." + "Set the process for CONNECTION to PROCESS." (put connection 'dictionary-connection-process process)) (defsubst dictionary-connection-set-buffer (connection buffer) - "Set the buffer for `connection' to `buffer'." + "Set the buffer for CONNECTION to BUFFER." (put connection 'dictionary-connection-buffer buffer)) (defun dictionary-connection-create-data (buffer process point) - "Create a new connection data based on `buffer', `process', and `point'." + "Create a new connection data based on BUFFER, PROCESS, and POINT." (let ((connection (make-symbol "connection"))) (put connection 'connection t) (dictionary-connection-set-read-point connection point) @@ -65,7 +65,7 @@ connection)) (defun dictionary-connection-open (server port) - "Open a connection to `server' and `port'. + "Open a connection to SERVER at PORT. A data structure identifing the connection is returned" (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" @@ -78,7 +78,7 @@ A data structure identifing the connection is returned" (dictionary-connection-create-data process-buffer process (point-min))))) (defun dictionary-connection-status (connection) - "Return the status of the connection. + "Return the status of the CONNECTION. Possible return values are the symbols: nil: argument is no connection object 'none: argument has no connection @@ -97,7 +97,7 @@ nil: argument is no connection object 'up)))))) (defun dictionary-connection-close (connection) - "Force closing of the connection." + "Force closing of the CONNECTION." (when (dictionary-connection-p connection) (let ((buffer (dictionary-connection-buffer connection)) (process (dictionary-connection-process connection))) @@ -110,7 +110,7 @@ nil: argument is no connection object (dictionary-connection-set-buffer connection nil)))) (defun dictionary-connection-send (connection data) - "Send `data' to the process." + "Send DATA to the process stored in CONNECTION." (unless (eq (dictionary-connection-status connection) 'up) (error "Connection is not up")) (with-current-buffer (dictionary-connection-buffer connection) @@ -119,11 +119,11 @@ nil: argument is no connection object (process-send-string (dictionary-connection-process connection) data))) (defun dictionary-connection-send-crlf (connection data) - "Send `data' together with CRLF to the process." + "Send DATA together with CRLF to the process found in CONNECTION." (dictionary-connection-send connection (concat data "\r\n"))) (defun dictionary-connection-read (connection delimiter) - "Read data until `delimiter' is found inside the buffer." + "Read data from CONNECTION until DELIMITER is found inside the buffer." (unless (eq (dictionary-connection-status connection) 'up) (error "Connection is not up")) (let ((case-fold-search nil) @@ -142,11 +142,13 @@ nil: argument is no connection object result)))) (defun dictionary-connection-read-crlf (connection) - "Read until a line is completedx with CRLF" + "Read from CONNECTION until a line is completed with CRLF." (dictionary-connection-read connection "\015?\012")) (defun dictionary-connection-read-to-point (connection) - "Read until a line is consisting of a single point" + "Read from CONNECTION until an end of entry is encountered. +End of entry is a decimal point found on a line by itself. +" (dictionary-connection-read connection "\015?\012[.]\015?\012")) (provide 'dictionary-connection) From ca0de4d1e0bd718568dfca8daf5498754145941a Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 11:31:51 +0100 Subject: [PATCH 063/148] * etc/NEWS: Add entry for dictionary.el --- etc/NEWS | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 63a740cf64c..843e93d5083 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1338,6 +1338,15 @@ These themes are designed for colour-contrast accessibility. You can load the new themes using 'M-x customize-themes' or 'load-theme' from your init file. +** Dictionary mode + +This is a mode for searching a RFC 2229 dictionary +server. 'dictionary' opens a buffer for starting +operations. 'dictionary-search' performs a lookup for a word. It also +supports a 'dictionary-tooltip-mode' which performs a lookup of the +word under the mouse in 'dictionary-tooltip-dictionary' (which must be +customized first). + * Incompatible Editing Changes in Emacs 28.1 From 62d14e10f9dc52136d951a5702ba70d4be171d84 Mon Sep 17 00:00:00 2001 From: Torsten Hilbrich Date: Mon, 14 Dec 2020 11:44:12 +0100 Subject: [PATCH 064/148] * lisp/net/dictionary.el (dictionary-pre-buffer): Unify casing Let all the buttons begins with an upper-case character and the rest of the text is lower-case. --- lisp/net/dictionary.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f06efaea375..0df9d8b1423 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -742,7 +742,7 @@ of matching words." 'callback 'dictionary-restore-state 'help-echo (purecopy "Mouse-2 to go backwards in history")) (insert " ") - (insert-button "[Search Definition]" :type 'dictionary-button + (insert-button "[Search definition]" :type 'dictionary-button 'callback 'dictionary-search 'help-echo (purecopy "Mouse-2 to look up a new word")) (insert " ") @@ -758,11 +758,11 @@ of matching words." (insert "\n ") - (insert-button "[Select Dictionary]" :type 'dictionary-button + (insert-button "[Select dictionary]" :type 'dictionary-button 'callback 'dictionary-select-dictionary 'help-echo (purecopy "Mouse-2 to select dictionary for future searches")) (insert " ") - (insert-button "[Select Match Strategy]" :type 'dictionary-button + (insert-button "[Select match strategy]" :type 'dictionary-button 'callback 'dictionary-select-strategy 'help-echo (purecopy "Mouse-2 to select matching algorithm")) (insert "\n\n"))) From 6858119bcd4c34f5a28440b69803e9d7f99a35f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 14 Dec 2020 12:31:54 +0100 Subject: [PATCH 065/148] ; * lisp/progmodes/project.el (project-switch-use-entire-map): Typo --- lisp/progmodes/project.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d4c0e46c851..d786c3f967a 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1281,7 +1281,7 @@ If nil, `project-switch-project' will only recognize commands listed in `project-switch-commands' and signal an error when others are invoked. Otherwise, all keys in `project-prefix-map' are legal even if they aren't listed in the dispatch menu." - :type 'bool + :type 'boolean :version "28.1") (defun project--keymap-prompt () From c9758ba48a805406ddd538aac33354fa400ac14a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 14:52:46 +0100 Subject: [PATCH 066/148] * lisp/bookmark.el: Doc fix. --- lisp/bookmark.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index b9bdbe86d69..afcfd2e425d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -26,7 +26,8 @@ ;; This package is for setting "bookmarks" in files. A bookmark ;; associates a string with a location in a certain file. Thus, you ;; can navigate your way to that location by providing the string. -;; See the "User Variables" section for customizations. +;; +;; Type `M-x customize-group RET boomark RET' for user options. ;;; Code: From f1dae2551c9b30f1f1333416df195b0907c54f4f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 15:09:14 +0100 Subject: [PATCH 067/148] Prefer setq to set+quote * lisp/cedet/semantic/senator.el (senator-lazy-highlight-update): * lisp/emulation/edt.el (edt-find, edt-restore-key) (edt-remember): * lisp/eshell/em-ls.el (eshell-ls--insert-directory): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/progmodes/hideif.el (hide-ifdef-mode): * test/lisp/url/url-future-tests.el (url-future-tests): Prefer setq to set+quote. --- lisp/cedet/semantic/senator.el | 2 +- lisp/emulation/edt.el | 12 ++++++------ lisp/eshell/em-ls.el | 6 +++--- lisp/net/tramp-sh.el | 2 +- lisp/progmodes/hideif.el | 2 +- test/lisp/url/url-future-tests.el | 8 ++++---- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index 49c1933508f..d21350749ba 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -810,7 +810,7 @@ if available." (defun senator-lazy-highlight-update () "Force lazy highlight update." (lazy-highlight-cleanup t) - (set 'isearch-lazy-highlight-last-string nil) + (setq isearch-lazy-highlight-last-string nil) (setq isearch-adjusted t) (isearch-update)) diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index f61de9208d1..7601731a85a 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -691,7 +691,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (defun edt-find () "Find first occurrence of string in current direction and save it." (interactive) - (set 'edt-find-last-text (read-string "Search: ")) + (setq edt-find-last-text (read-string "Search: ")) (if (equal edt-direction-string edt-forward-string) (edt-find-forward t) (edt-find-backward t))) @@ -1321,8 +1321,8 @@ Definition is stored in `edt-last-replaced-key-definition'." (if edt-last-replaced-key-definition (progn (let (edt-key-definition) - (set 'edt-key-definition - (read-key-sequence "Press the key to be restored: ")) + (setq edt-key-definition + (read-key-sequence "Press the key to be restored: ")) (if (string-equal "\C-m" edt-key-definition) (message "Key not restored") (progn @@ -1639,12 +1639,12 @@ Argument NUM is the number of times to duplicate the line." (progn (end-kbd-macro nil) (let (edt-key-definition) - (set 'edt-key-definition - (read-key-sequence "Enter key for binding: ")) + (setq edt-key-definition + (read-key-sequence "Enter key for binding: ")) (if (string-equal "\C-m" edt-key-definition) (message "Key sequence not remembered") (progn - (set 'edt-learn-macro-count (+ edt-learn-macro-count 1)) + (setq edt-learn-macro-count (+ edt-learn-macro-count 1)) (setq edt-last-replaced-key-definition (lookup-key (current-global-map) edt-key-definition)) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 6b306f77874..44a0df6a3ed 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -274,9 +274,9 @@ instead." (font-lock-mode -1) (setq font-lock-defaults nil) (if (boundp 'font-lock-buffers) - (set 'font-lock-buffers - (delq (current-buffer) - (symbol-value 'font-lock-buffers))))) + (setq font-lock-buffers + (delq (current-buffer) + (symbol-value 'font-lock-buffers))))) (require 'em-glob) (let* ((insert-func 'insert) (error-func 'insert) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 98537a100f3..34be4fcba93 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3562,7 +3562,7 @@ implementation will be used." ;; Make `last-coding-system-used' have the right value. (when coding-system-used - (set 'last-coding-system-used coding-system-used)))) + (setq last-coding-system-used coding-system-used)))) (tramp-flush-file-properties v localname) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 7cbc9708fce..9c8343fca00 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -304,7 +304,7 @@ Several variables affect how the hiding is done: ;; (C-c @ C) every time before hiding current buffer. ;; (setq-local hide-ifdef-env ;; (default-value 'hide-ifdef-env)) - (set 'hide-ifdef-env (default-value 'hide-ifdef-env)) + (setq hide-ifdef-env (default-value 'hide-ifdef-env)) ;; Some C/C++ headers might have other ways to prevent reinclusion and ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil. (setq-local hide-ifdef-expand-reinclusion-protection diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index a07730a2be6..43668036b69 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -31,13 +31,13 @@ (let* (url-future-tests--saver (text "running future") (good (make-url-future :value (lambda () (format text)) - :callback (lambda (f) (set 'url-future-tests--saver f)))) + :callback (lambda (f) (setq url-future-tests--saver f)))) (bad (make-url-future :value (lambda () (/ 1 0)) - :errorback (lambda (&rest d) (set 'url-future-tests--saver d)))) + :errorback (lambda (&rest d) (setq url-future-tests--saver d)))) (tocancel (make-url-future :value (lambda () (/ 1 0)) - :callback (lambda (f) (set 'url-future-tests--saver f)) + :callback (lambda (f) (setq url-future-tests--saver f)) :errorback (lambda (&rest d) - (set 'url-future-tests--saver d))))) + (setq url-future-tests--saver d))))) (should (equal good (url-future-call good))) (should (equal good url-future-tests--saver)) (should (equal text (url-future-value good))) From 4c41a8acc0e3877404ab99e56420bcdd4e27bdc2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 15:16:13 +0100 Subject: [PATCH 068/148] Make XEmacs compat variable warning-level-aliases obsolete * lisp/emacs-lisp/warnings.el (warning-level-aliases): Make obsolete. (display-warning): Warn when using one of the warning levels defined in above obsolete variable. (Bug#44849) * lisp/url/url-proxy.el (url-find-proxy-for-url): Replace obsolete warning type 'critical with :error. --- lisp/emacs-lisp/warnings.el | 7 +++++-- lisp/url/url-proxy.el | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index f525ea433ad..28458847cc2 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -67,6 +67,7 @@ Level :debug is ignored by default (see `warning-minimum-level').") Each element looks like (ALIAS . LEVEL) and defines ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels'; it may not itself be an alias.") +(make-obsolete-variable 'warning-level-aliases 'warning-levels "28.1") (define-obsolete-variable-alias 'display-warning-minimum-level 'warning-minimum-level "28.1") @@ -256,8 +257,10 @@ entirely by setting `warning-suppress-types' or (setq level :warning)) (unless buffer-name (setq buffer-name "*Warnings*")) - (if (assq level warning-level-aliases) - (setq level (cdr (assq level warning-level-aliases)))) + (with-suppressed-warnings ((obsolete warning-level-aliases)) + (when-let ((new (cdr (assq level warning-level-aliases)))) + (warn "Warning level `%s' is obsolete; use `%s' instead" level new) + (setq level new))) (or (< (warning-numeric-level level) (warning-numeric-level warning-minimum-log-level)) (warning-suppress-p type warning-suppress-log-types) diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index 698a87098ba..ad04a2d94a3 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el @@ -59,7 +59,7 @@ ((string-match "^socks +" proxy) (concat "socks://" (substring proxy (match-end 0)))) (t - (display-warning 'url (format "Unknown proxy directive: %s" proxy) 'critical) + (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error) nil)))) (autoload 'url-http "url-http") From 95c9aad04117ce3ff2448be45ec873aa9841ca74 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 15:48:38 +0100 Subject: [PATCH 069/148] Remove more references to old versions from FAQ * doc/misc/efaq.texi (Learning how to do something) (Installing Emacs, Emacs for GNUstep, Emacs for macOS): Remove more references to Emacs 22 and older from FAQ. --- doc/misc/efaq.texi | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 462eb4cf3ae..c926d7e97a7 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -594,11 +594,11 @@ You can get a printed reference card listing commands and keys to invoke them. You can order one from the FSF for $2 (or 10 for $18), or you can print your own from the @file{etc/refcards/refcard.tex} or @file{etc/refcards/refcard.pdf} files in the Emacs distribution. -Beginning with version 21.1, the Emacs distribution comes with -translations of the reference card into several languages; look for -files named @file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} -is a two-letter code of the language. For example, the German version -of the reference card is in the files @file{etc/refcards/de-refcard.tex} +The Emacs distribution comes with translations of the reference card +into several languages; look for files named +@file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} is a +two-letter code of the language. For example, the German version of +the reference card is in the files @file{etc/refcards/de-refcard.tex} and @file{etc/refcards/de-refcard.pdf}. @item @@ -3322,7 +3322,7 @@ the main GNU distribution site, sources are available as @c Don't include VER in the file name, because pretests are not there. @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}.) +(Replace @samp{VERSION} with the relevant version number, e.g., @samp{28.1}.) @item Next uncompress and extract the source files. This requires @@ -3622,8 +3622,8 @@ For MS-DOS, @pxref{Emacs for MS-DOS}. @section Where can I get Emacs for GNUstep? @cindex GNUstep, Emacs for -Beginning with version 23.1, Emacs supports GNUstep natively. -See the file @file{nextstep/INSTALL} in the distribution. +Emacs supports GNUstep natively. See the file @file{nextstep/INSTALL} +in the distribution. @node Emacs for macOS @section Where can I get Emacs for macOS? @@ -3631,8 +3631,8 @@ See the file @file{nextstep/INSTALL} in the distribution. @cindex Macintosh, Emacs for @cindex macOS, Emacs for -Beginning with version 22.1, Emacs supports macOS natively. -See the file @file{nextstep/INSTALL} in the distribution. +Emacs supports macOS natively. See the file @file{nextstep/INSTALL} +in the distribution. @c ------------------------------------------------------------ @node Key bindings From 5c361035dbcc1e1bc57c0c00db35753586a9a324 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 16:22:22 +0100 Subject: [PATCH 070/148] Don't recommend setnu and wb-line-number * doc/misc/efaq.texi (Displaying the current line or column): Remove reference to third-party alternatives to display-line-numbers-mode. --- doc/misc/efaq.texi | 2 -- 1 file changed, 2 deletions(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index c926d7e97a7..9821bbe4789 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1672,8 +1672,6 @@ would use with @code{display-line-numbers}. There is also the @samp{linum} package (distributed with Emacs since version 23.1) which will henceforth become obsolete. Users and developers are encouraged to use @samp{display-line-numbers} instead. -The packages @samp{setnu} and @samp{wb-line-number} (not distributed -with Emacs) also implement this feature. @node Displaying the current file name in the titlebar @section How can I modify the titlebar to contain the current file name? From e8a358c3be90949645a1038cfd43553794c49441 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 16:23:51 +0100 Subject: [PATCH 071/148] Update value of frame-title-format in FAQ * doc/misc/efaq.texi (Displaying the current file name in the titlebar): Fix default value of frame-title-format. --- doc/misc/efaq.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 9821bbe4789..06a17d9c468 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1692,7 +1692,7 @@ machine at which Emacs was invoked. This is done by setting @code{frame-title-format} to the default value of @lisp -(multiple-frames "%b" ("" invocation-name "@@" (system-name))) +(multiple-frames "%b" ("" "%b - GNU Emacs at " system-name)) @end lisp To modify the behavior such that frame titlebars contain the buffer's From f6454ad6cd0dba9ab7ebff9b2959c05a607442ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulrich=20=C3=96lmann?= Date: Mon, 14 Dec 2020 16:02:54 +0100 Subject: [PATCH 072/148] Add a DirectoryMode to the Emacs Server example * doc/emacs/misc.texi (Emacs Server): Update example * doc/emacs/misc.texi (Emacs Server): The socket containing directory is per default created with permissions 0755 by the socket-unit. However this is considered unsafe since commit [1], so enhance unit example with systemd configuration directive `DirectoryMode=' to create it with safe permissions, see https://www.freedesktop.org/software/systemd/man/systemd.socket.html#DirectoryMode= [1] 2003-04-12 "(server-socket-name): Use new safe location for socket." Copyright-paperwork-exempt: yes --- doc/emacs/misc.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index c2c382ead0b..54fafae5654 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1709,6 +1709,7 @@ connections. A setup to use this functionality could be: @example [Socket] ListenStream=/path/to/.emacs.socket +DirectoryMode=0700 [Install] WantedBy=sockets.target From 252366866b5691965c8c752aa103ab157a6f3aaa Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 14 Dec 2020 16:44:00 +0100 Subject: [PATCH 073/148] Add a new recursively bound `current-minibuffer-command' variable * doc/lispref/commands.texi (Command Loop Info): Document it (bug#45177). * src/callint.c (Fcall_interactively): Bind it. * src/keyboard.c (syms_of_keyboard): Define current-minibuffer-command. --- doc/lispref/commands.texi | 7 +++++++ etc/NEWS | 6 ++++++ src/callint.c | 5 +++++ src/keyboard.c | 7 +++++++ 4 files changed, 25 insertions(+) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index ebfda01671e..15d7e4e3a71 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -928,6 +928,13 @@ remapping), and @code{this-original-command} gives the command that was specified to run but remapped into another command. @end defvar +@defvar current-minibuffer-command +This has the same value as @code{this-command}, but is bound +recursively when entering a minibuffer. This variable can be used +from minibuffer hooks and the like to determine what command opened +the current minibuffer session. +@end defvar + @defun this-command-keys This function returns a string or vector containing the key sequence that invoked the present command. Any events read by the command diff --git a/etc/NEWS b/etc/NEWS index 635da2d84ab..a5e2c9cf26a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1437,6 +1437,12 @@ that makes it a valid button. ** Miscellaneous ++++ + +*** New variable 'current-minibuffer-command'. +This is like 'this-command', but is bound recursively when entering +the minibuffer. + +++ *** New function 'object-intervals'. This function returns a copy of the list of intervals (i.e., text diff --git a/src/callint.c b/src/callint.c index f80436f3d91..a221705f676 100644 --- a/src/callint.c +++ b/src/callint.c @@ -283,6 +283,11 @@ invoke it (via an `interactive' spec that contains, for instance, an Lisp_Object save_real_this_command = Vreal_this_command; Lisp_Object save_last_command = KVAR (current_kboard, Vlast_command); + /* Bound recursively so that code can check the current command from + code running from minibuffer hooks (and the like), without being + overwritten by subsequent minibuffer calls. */ + specbind (Qcurrent_minibuffer_command, Vreal_this_command); + if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; else diff --git a/src/keyboard.c b/src/keyboard.c index dbca5be91e4..54232aaea1e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11830,6 +11830,13 @@ will be in `last-command' during the following command. */); doc: /* This is like `this-command', except that commands should never modify it. */); Vreal_this_command = Qnil; + DEFSYM (Qcurrent_minibuffer_command, "current-minibuffer-command"); + DEFVAR_LISP ("current-minibuffer-command", Vcurrent_minibuffer_command, + doc: /* This is like `this-command', but bound recursively. +Code running from (for instance) a minibuffer hook can check this variable +to see what command invoked the current minibuffer. */); + Vcurrent_minibuffer_command = Qnil; + DEFVAR_LISP ("this-command-keys-shift-translated", Vthis_command_keys_shift_translated, doc: /* Non-nil if the key sequence activating this command was shift-translated. From 8b3de06347dfcb4afab93f17f32297fe721b363b Mon Sep 17 00:00:00 2001 From: Tomas Nordin Date: Mon, 14 Dec 2020 16:58:07 +0100 Subject: [PATCH 074/148] Fix narrow-to-defun in python-mode * lisp/progmodes/python.el (python-nav--beginning-of-defun): Make narrow-to-defun work better in classes (bug#40563). Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d75944a702f..d58b32f3c3c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1404,7 +1404,7 @@ With positive ARG search backwards, else search forwards." (line-beg-pos (line-beginning-position)) (line-content-start (+ line-beg-pos (current-indentation))) (pos (point-marker)) - (beg-indentation + (body-indentation (and (> arg 0) (save-excursion (while (and @@ -1415,9 +1415,16 @@ With positive ARG search backwards, else search forwards." 0)))) (found (progn - (when (and (< arg 0) - (python-info-looking-at-beginning-of-defun)) + (when (and (python-info-looking-at-beginning-of-defun) + (or (< arg 0) + ;; If looking at beginning of defun, and if + ;; pos is > line-content-start, ensure a + ;; backward re search match this defun by + ;; going to end of line before calling + ;; re-search-fn bug#40563 + (and (> arg 0) (> pos line-content-start)))) (end-of-line 1)) + (while (and (funcall re-search-fn python-nav-beginning-of-defun-regexp nil t) (or (python-syntax-context-type) @@ -1425,7 +1432,7 @@ With positive ARG search backwards, else search forwards." ;; backwards by checking indentation. (and (> arg 0) (not (= (current-indentation) 0)) - (>= (current-indentation) beg-indentation))))) + (>= (current-indentation) body-indentation))))) (and (python-info-looking-at-beginning-of-defun) (or (not (= (line-number-at-pos pos) (line-number-at-pos))) From 10bc4eac5bb2e7e4b520628286a52f0508332119 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 14 Dec 2020 17:07:41 +0100 Subject: [PATCH 075/148] Tool bar documentation clarification: Mention forcing updates * doc/lispref/keymaps.texi (Tool Bar): Document that flipping the status of a tool bar item doesn't necessarily update the visuals (bug#42957). --- doc/lispref/keymaps.texi | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 6635f50960a..9daeb2c77f9 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2812,6 +2812,11 @@ the shift modifier: @xref{Function Keys}, for more information about how to add modifiers to function keys. +If you have functions that change whether a tool bar item is enabled +or not, this status is not necessarily updated visually immediately. +To force recalculation of the tool bar, call +@code{force-mode-line-update} (@pxref{Mode Line Format}). + @node Modifying Menus @subsection Modifying Menus @cindex menu modification From 0dd8d53344a822842660d2ac75108f40ba9ff0f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= Date: Mon, 14 Dec 2020 17:16:00 +0100 Subject: [PATCH 076/148] Make goto-char offer the number at point as default * lisp/subr.el (read-natnum-interactive): New function to read natural numbers for interactive functions. * src/editfns.c (Fgoto_char): Call read-natnum-interactive from the interactive definition of goto-char to offer the number at point as default. Also expand the docstring to document this new interactive behavior. * doc/emacs/basic.texi (Moving Point): Expand the Emacs manual to document this new behavior. * etc/NEWS: And announce it (bug#45199). --- doc/emacs/basic.texi | 5 ++++- etc/NEWS | 4 ++++ lisp/subr.el | 9 +++++++++ src/editfns.c | 9 +++++++-- 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index cd1ffbebd7c..77c80547462 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -310,7 +310,10 @@ Scroll one screen backward, and move point onscreen if necessary @kindex M-g c @findex goto-char Read a number @var{n} and move point to buffer position @var{n}. -Position 1 is the beginning of the buffer. +Position 1 is the beginning of the buffer. If point is on or just +after a number in the buffer, that is the default for @var{n}. Just +type @key{RET} in the minibuffer to use it. You can also specify +@var{n} by giving @kbd{M-g c} a numeric prefix argument. @item M-g M-g @itemx M-g g diff --git a/etc/NEWS b/etc/NEWS index a5e2c9cf26a..05274a2d6c6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -257,6 +257,10 @@ When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed buffer to be able to move point to the inaccessible portion. 'goto-line-relative' is bound to 'C-x n g'. ++++ +** When called interactively, 'goto-char' now offers the number at +point as default. + +++ ** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' shows equivalent key bindings for all commands that have them. diff --git a/lisp/subr.el b/lisp/subr.el index ed235ee1f72..77c19c5bbf3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2820,6 +2820,15 @@ There is no need to explicitly add `help-char' to CHARS; (message "%s%s" prompt (char-to-string char)) char)) +(defun goto-char--read-natnum-interactive (prompt) + "Get a natural number argument, optionally prompting with PROMPT. +If there is a natural number at point, use it as default." + (if (and current-prefix-arg (not (consp current-prefix-arg))) + (list (prefix-numeric-value current-prefix-arg)) + (let* ((number (number-at-point)) + (default (and (natnump number) number))) + (list (read-number prompt default))))) + ;; Behind display-popup-menus-p test. (declare-function x-popup-dialog "menu.c" (position contents &optional header)) diff --git a/src/editfns.c b/src/editfns.c index 4104edd77fd..e4c4141ef5e 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -188,11 +188,16 @@ DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0, return build_marker (current_buffer, PT, PT_BYTE); } -DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", +DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, + "(goto-char--read-natnum-interactive \"Go to char: \")", doc: /* Set point to POSITION, a number or marker. Beginning of buffer is position (point-min), end is (point-max). -The return value is POSITION. */) +The return value is POSITION. + +If called interactively, a numeric prefix argument specifies +POSITION; without a numeric prefix argument, read POSITION from the +minibuffer. The default value is the number at point (if any). */) (register Lisp_Object position) { if (MARKERP (position)) From b63cb95ad441a47afcf6c7848e6583b89b0e6755 Mon Sep 17 00:00:00 2001 From: Robert Thorpe Date: Mon, 14 Dec 2020 17:51:25 +0100 Subject: [PATCH 077/148] Mention how to handle user names with @ in rmail * doc/emacs/rmail.texi (Remote Mailboxes): Mention how to work around the problem with user names like foo@example.com (bug#16946). Copyright-paperwork-exempt: yes --- doc/emacs/rmail.texi | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 467c5269866..0c47812449b 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1591,6 +1591,14 @@ value is used. Otherwise, Rmail will ask you for the password to use. @end enumerate +On some mail servers the usernames include domain information, which +can mean they contain the @samp{@@} character. The inbox specifier +string uses @samp{@@} to signal the start of the mailserver name. +This creates confusion for movemail. If your username contains +@samp{@@} and you're using Mailutils @command{movemail} then you can +fix this: Replace @code{@@} in the user name with its @acronym{URL} +encoding @samp{%40}. + @vindex rmail-movemail-flags If you need to pass additional command-line flags to @command{movemail}, set the variable @code{rmail-movemail-flags} a list of the flags you From e5348f125ff03ac70713e5b227f9e51f759a587b Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Mon, 14 Dec 2020 17:59:58 +0100 Subject: [PATCH 078/148] * etc/emacs.service: * etc/emacs.service (ExecStart): Make Emacs exit from systemd work better (bug#45181). The problem here is the exit code 15, which emacs will return *only* if it has received SIGTERM. I believe what's happening here is that emacsclient will call kill-emacs but not wait until the emacs server has properly shut down. However, it's supposed to wait for the shutdown as an "ExecStop" command according to "man systemd.service". So since the process is still alive when emacsclient comes back, systemd will still issue SIGTERM, making emacs return 15 (maybe after calling kill- emacs again?!). Copyright-paperwork-exempt: yes --- etc/emacs.service | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/etc/emacs.service b/etc/emacs.service index c99c6779f58..809c49cdbc5 100644 --- a/etc/emacs.service +++ b/etc/emacs.service @@ -9,7 +9,11 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ [Service] Type=notify ExecStart=emacs --fg-daemon -ExecStop=emacsclient --eval "(kill-emacs)" + +# Emacs will exit with status 15 after having received SIGTERM, which +# is the default "KillSignal" value systemd uses to stop services. +SuccessExitStatus=15 + # The location of the SSH auth socket varies by distribution, and some # set it from PAM, so don't override by default. # Environment=SSH_AUTH_SOCK=%t/keyring/ssh From b857ea24f7bc5288faa920e6c3174cf1ee958b70 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 18:08:20 +0100 Subject: [PATCH 079/148] * lisp/play/5x5.el: Fix typo. Remove redundant :group args. --- lisp/play/5x5.el | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 3d4843a39c6..5ab1493c7a9 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -31,7 +31,7 @@ ;; o The code for updating the grid needs to be re-done. At the moment it ;; simply re-draws the grid every time a move is made. ;; -;; o Look into tarting up the display with color. gamegrid.el looks +;; o Look into starting up the display with color. gamegrid.el looks ;; interesting, perhaps that is the way to go? ;;; Thanks: @@ -47,8 +47,6 @@ ;;; Code: -;; Things we need. - (eval-when-compile (require 'cl-lib)) ;; Customize options. @@ -60,33 +58,27 @@ (defcustom 5x5-grid-size 5 "Size of the playing area." - :type 'integer - :group '5x5) + :type 'integer) (defcustom 5x5-x-scale 4 "X scaling factor for drawing the grid." - :type 'integer - :group '5x5) + :type 'integer) (defcustom 5x5-y-scale 3 "Y scaling factor for drawing the grid." - :type 'integer - :group '5x5) + :type 'integer) (defcustom 5x5-animate-delay .01 "Delay in seconds when animating a solution crack." - :type 'number - :group '5x5) + :type 'number) (defcustom 5x5-hassle-me t "Should 5x5 ask you when you want to do a destructive operation?" - :type 'boolean - :group '5x5) + :type 'boolean) (defcustom 5x5-mode-hook nil "Hook run on starting 5x5." - :type 'hook - :group '5x5) + :type 'hook) ;; Non-customize variables. From afee776594fc7df881106fab5188f3dd40a3f8b8 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 10 Dec 2020 19:52:00 -0800 Subject: [PATCH 080/148] Fix logic of gnus-search-imap-handle-date * lisp/gnus/gnus-search.el (gnus-search-imap-handle-date): Just rewrite this whole ridiculous function. --- lisp/gnus/gnus-search.el | 61 +++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 32 deletions(-) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 0e67fac002d..829e0fa3ad1 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1252,44 +1252,41 @@ means (usually the \"mark\" keyword)." (gnus-search-imap-handle-string engine (cdr expr)))))))))) (cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap) - (date list)) + (date list)) "Turn DATE into a date string recognizable by IMAP. While other search engines can interpret partially-qualified dates such as a plain \"January\", IMAP requires an absolute date. DATE is a list of (dd mm yyyy), any element of which could be -nil. Massage those numbers into the most recent past occurrence -of whichever date elements are present." - (let ((now (decode-time (current-time)))) - ;; Set nil values to 1, current-month, current-year, or else 1, 1, - ;; current-year, depending on what we think the user meant. - (unless (seq-elt date 1) - (setf (seq-elt date 1) - (if (seq-elt date 0) - (seq-elt now 4) - 1))) - (unless (seq-elt date 0) - (setf (seq-elt date 0) 1)) - (unless (seq-elt date 2) - (setf (seq-elt date 2) - (seq-elt now 5))) - ;; Fiddle with the date until it's in the past. There - ;; must be a way to combine all these steps. - (unless (< (seq-elt date 2) - (seq-elt now 5)) - (when (< (seq-elt now 3) - (seq-elt date 0)) - (cl-decf (seq-elt date 1))) - (cond ((zerop (seq-elt date 1)) - (setf (seq-elt date 1) 1) - (cl-decf (seq-elt date 2))) - ((< (seq-elt now 4) - (seq-elt date 1)) - (cl-decf (seq-elt date 2)))))) - (format-time-string "%e-%b-%Y" (apply #'encode-time - (append '(0 0 0) - date)))) +nil (except that (dd nil yyyy) is not allowed). Massage those +numbers into the most recent past occurrence of whichever date +elements are present." + (pcase-let ((`(,nday ,nmonth ,nyear) + (seq-subseq (decode-time (current-time)) + 3 6)) + (`(,dday ,dmonth ,dyear) date)) + (unless (and dday dmonth dyear) + (unless dday (setq dday 1)) + (if dyear + ;; If we have a year, then leave everything else as is or set + ;; to 1. + (setq dmonth (or dmonth 1)) + (if dmonth + (setq dyear + (if (or (> dmonth nmonth) + (and (= dmonth nmonth) + (> dday nday))) + ;; If our day/month combo is ahead of "now", + ;; move the year back. + (1- nyear) + nyear)) + (setq dmonth 1)))) + (format-time-string + "%e-%b-%Y" + (apply #'encode-time + (append '(0 0 0) + (list dday dmonth dyear)))))) (cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap) (str string)) From 668f0a7f847264dbc9549aeb2d42b967e25eef5f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 14 Dec 2020 20:09:04 +0200 Subject: [PATCH 081/148] Fix point location when completing in gdb-mi.el * lisp/progmodes/gdb-mi.el (def-gdb-auto-update-handler): Don't force window-start position, so that redisplay doesn't move point when popping completion window below the GUD one. (Bug#45052) --- lisp/progmodes/gdb-mi.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index e785acd2840..2162df44f2b 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -2891,7 +2891,7 @@ If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." (,custom-defun) (gdb-update-buffer-name) ,@(when (not nopreserve) - '((set-window-start window start) + '((set-window-start window start t) (set-window-point window p)))))) (defmacro def-gdb-trigger-and-handler (trigger-name gdb-command From 2f1441cbe3ccd49037e2464485658f7f20f3d804 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 14 Dec 2020 19:21:28 +0100 Subject: [PATCH 082/148] Make XEmacs entry in the FAQ more contemporary * doc/misc/efaq.texi (Difference between Emacs and XEmacs): Make XEmacs entry in the FAQ more contemporary. Remove part about re-using XEmacs code; this is not likely to be relevant these days and in any case is not a frequently asked question. (Bug#45235) --- doc/misc/efaq.texi | 34 ++++++++++------------------------ 1 file changed, 10 insertions(+), 24 deletions(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 06a17d9c468..83c0a19d391 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3390,7 +3390,7 @@ problem (@pxref{Reporting bugs}). * Packages that do not come with Emacs:: * Spell-checkers:: * Current GNU distributions:: -* Difference between Emacs and XEmacs:: +* What was XEmacs?:: * Emacs for minimalists:: * Emacs for MS-DOS:: * Emacs for MS-Windows:: @@ -3526,35 +3526,21 @@ A list of sites mirroring @samp{ftp.gnu.org} can be found at @uref{https://www.gnu.org/prep/ftp} -@node Difference between Emacs and XEmacs -@section What is the difference between Emacs and XEmacs (formerly Lucid Emacs)? +@node What was XEmacs? +@section What was XEmacs? @cindex XEmacs -@cindex Difference Emacs and XEmacs -@cindex Lucid Emacs -@cindex Epoch XEmacs was a branch version of Emacs that is no longer actively -developed. XEmacs was first called Lucid Emacs, and was initially -derived from a prerelease version of Emacs 19. In this FAQ, we use -the name ``Emacs'' only for the official version. +developed. XEmacs last released a new version on January 30, 2009, +and it lacks many important features that exist in Emacs. Since its +development has stopped, we do not expect to see any new releases. -XEmacs last released a new version on January 30, 2009, and it lacks -many important features that exists in Emacs. In the past, it was not -uncommon for Emacs packages to include code for compatibility with -XEmacs. Nowadays, although some packages still maintain such -compatibility code, several of the more popular built-in and third -party packages have either stopped supporting XEmacs or were developed +In the past, it was not uncommon for Emacs packages to include code +for compatibility with XEmacs. Nowadays, most built-in and third party +packages have either stopped supporting XEmacs or were developed exclusively for Emacs. -Some XEmacs code has been contributed to Emacs, and we would like to -use other parts, but the earlier XEmacs maintainers did not always -keep track of the authors of contributed code, which makes it -impossible for the FSF to get copyright papers signed for that code. -(The FSF requires these papers for all the code included in the Emacs -release, aside from generic C support packages that retain their -separate identity and are not integrated into the code of Emacs -proper.) - +XEmacs was initially derived from a prerelease version of Emacs 19. If you want to talk about these two versions and distinguish them, please call them ``Emacs'' and ``XEmacs.'' To contrast ``XEmacs'' with ``GNU Emacs'' would be misleading, since XEmacs too has its From 47a854bf24c8a36bf1e8ac32c8b5c9ebcba1d90a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 14 Dec 2020 20:23:24 +0200 Subject: [PATCH 083/148] Improve accuracy of scrolling commands * src/xdisp.c (move_it_vertically_backward): Don't rely on line_bottom_y for accurate calculation of the next screen line's Y coordinate: it doesn't work when the current screen line was not yet traversed. Instead, record the previous Y coordinate and reseat there if overshoot is detected. * src/window.c (window_scroll_pixel_based): Calculate the new window-start point more accurately when screen lines have uneven height. (Bug#8355) --- src/window.c | 36 ++++++++++++++++-------------------- src/xdisp.c | 13 ++++++++++++- 2 files changed, 28 insertions(+), 21 deletions(-) diff --git a/src/window.c b/src/window.c index 8e75e460b2b..4eab786958f 100644 --- a/src/window.c +++ b/src/window.c @@ -5686,27 +5686,20 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) we would end up at the start of the line ending at ZV. */ if (dy <= 0) { - goal_y = it.current_y - dy; + goal_y = it.current_y + dy; move_it_vertically_backward (&it, -dy); - /* Extra precision for people who want us to preserve the - screen position of the cursor: effectively round DY to the - nearest screen line, instead of rounding to zero; the latter - causes point to move by one line after C-v followed by M-v, - if the buffer has lines of different height. */ - if (!NILP (Vscroll_preserve_screen_position) - && it.current_y - goal_y > 0.5 * flh) + /* move_it_vertically_backward above always overshoots if DY + cannot be reached exactly, i.e. if it falls in the middle + of a screen line. But if that screen line is large + (e.g., a tall image), it might make more sense to + undershoot instead. */ + if (goal_y - it.current_y > 0.5 * flh) { it_data = bidi_shelve_cache (); - struct it it2 = it; - - move_it_by_lines (&it, -1); - if (it.current_y < goal_y - 0.5 * flh) - { - it = it2; - bidi_unshelve_cache (it_data, false); - } - else - bidi_unshelve_cache (it_data, true); + struct it it1 = it; + if (line_bottom_y (&it1) - goal_y < goal_y - it.current_y) + move_it_by_lines (&it, 1); + bidi_unshelve_cache (it_data, true); } /* Ensure we actually do move, e.g. in case we are currently looking at an image that is taller that the window height. */ @@ -5718,8 +5711,11 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) { goal_y = it.current_y + dy; move_it_to (&it, ZV, -1, goal_y, -1, MOVE_TO_POS | MOVE_TO_Y); - /* See the comment above, for the reasons of this - extra-precision. */ + /* Extra precision for people who want us to preserve the + screen position of the cursor: effectively round DY to the + nearest screen line, instead of rounding to zero; the latter + causes point to move by one line after C-v followed by M-v, + if the buffer has lines of different height. */ if (!NILP (Vscroll_preserve_screen_position) && goal_y - it.current_y > 0.5 * flh) { diff --git a/src/xdisp.c b/src/xdisp.c index 96dd4fade25..699183f3f59 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10301,11 +10301,22 @@ move_it_vertically_backward (struct it *it, int dy) move_it_vertically (it, target_y - it->current_y); else { + struct text_pos last_pos; + int last_y, last_vpos; do { + last_pos = it->current.pos; + last_y = it->current_y; + last_vpos = it->vpos; move_it_by_lines (it, 1); } - while (target_y >= line_bottom_y (it) && IT_CHARPOS (*it) < ZV); + while (target_y > it->current_y && IT_CHARPOS (*it) < ZV); + if (it->current_y > target_y) + { + reseat (it, last_pos, true); + it->current_y = last_y; + it->vpos = last_vpos; + } } } } From c0c6cd2d5d7af82ddfd4d8d080d0aa8d7882d293 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 14 Dec 2020 19:30:01 +0100 Subject: [PATCH 084/148] Add 'remote-file-error' for Tramp * doc/lispref/errors.texi (Standard Errors): Add 'remote-file-error'. * etc/NEWS: Mention 'remote-file-error'. * lisp/net/ange-ftp.el (ftp-error): Add error condition `remote-file-error'. * lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Do not set `tramp-locked'. * lisp/net/tramp-compat.el (remote-file-error): Define if it doesn't exist. * lisp/net/tramp-sh.el (tramp-timeout-session): Check for "locked" property. (tramp-maybe-open-connection): Simplify. * lisp/net/tramp.el (tramp-locked, tramp-locker): Remove them. (tramp-file-name-handler): Do not set them. (with-tramp-locked-connection): New defmacro. (tramp-accept-process-output, tramp-send-string): Use it. * src/fileio.c (Qremote_file_error): New error symbol. * test/lisp/net/tramp-tests.el (tramp-test43-asynchronous-requests): Adapt test. Remove :unstable tag. --- doc/lispref/errors.texi | 11 +++- etc/NEWS | 61 +++++++++++-------- lisp/net/ange-ftp.el | 2 +- lisp/net/tramp-cmds.el | 3 - lisp/net/tramp-compat.el | 5 ++ lisp/net/tramp-sh.el | 13 ++-- lisp/net/tramp.el | 113 ++++++++++++++++------------------- src/fileio.c | 6 ++ test/lisp/net/tramp-tests.el | 27 +++++---- 9 files changed, 132 insertions(+), 109 deletions(-) diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index cd8694be8a3..ff9b3e57125 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -129,9 +129,18 @@ This is a subcategory of @code{file-error}. @xref{Modification Time}. This is a subcategory of @code{file-error}. It happens, when a file could not be watched for changes. @xref{File Notifications}. +@item remote-file-error +This is a subcategory of @code{file-error}, which results from +problems in accessing a remote file. @xref{Remote Files,,, emacs, The +GNU Emacs Manual}. Often, this error appears when timers, process +filters, process sentinels or special events in general try to access +a remote file, and collide with another remote file operation. In +general it is a good idea to write a bug report. @xref{Reporting +Bugs,,, emacs, The GNU Emacs Manual}. + @c net/ange-ftp.el @item ftp-error -This is a subcategory of @code{file-error}, which results from +This is a subcategory of @code{remote-file-error}, which results from problems in accessing a remote file using ftp. @xref{Remote Files,,, emacs, The GNU Emacs Manual}. diff --git a/etc/NEWS b/etc/NEWS index 05274a2d6c6..87463372d57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -89,7 +89,7 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". This is controlled by the new variable 'scroll-minibuffer-conservatively'. In addition, there is a new variable -`redisplay-adhoc-scroll-in-resize-mini-windows` to disable the +'redisplay-adhoc-scroll-in-resize-mini-windows' to disable the ad-hoc auto-scrolling when resizing minibuffer windows. It has been found that its heuristic can be counter productive in some corner cases, tho the cure may be worse than the disease. This said, the @@ -303,8 +303,8 @@ the buffer cycles the whole buffer between "only top-level headings", * Changes in Specialized Modes and Packages in Emacs 28.1 -** Loading dunnet.el in batch mode doesn't start the game any more -Instead you need to do 'emacs -f dun-batch' to start the game in +** Loading dunnet.el in batch mode doesn't start the game any more. +Instead you need to do "emacs -f dun-batch" to start the game in batch mode. ** Emacs Server @@ -523,21 +523,20 @@ tags to be considered as well. +++ *** New user option 'gnus-registry-register-all'. - If non-nil (the default), create registry entries for all messages. If nil, don't automatically create entries, they must be created manually. +++ -*** New user options to customise the summary line specs %[ and %]. +*** New user options to customise the summary line specs "%[" and "%]". Four new options introduced in customisation group 'gnus-summary-format'. These are 'gnus-sum-opening-bracket', 'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and -'gnus-sum-closing-bracket-adopted'. Their default values are '[', ']', -'<', '>' respectively. These variables control the appearance of '%[' -and '%]' specs in the summary line format. '%[' will normally display +'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]", +"<", ">" respectively. These options control the appearance of "%[" +and "%]" specs in the summary line format. "%[" will normally display the value of 'gnus-sum-opening-bracket', but can also be -'gnus-sum-opening-bracket-adopted' for the adopted articles. '%]' will +'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will normally display the value of 'gnus-sum-closing-bracket', but can also be 'gnus-sum-closing-bracket-adopted' for the adopted articles. @@ -1130,13 +1129,13 @@ If 'shr-width' is non-nil, it overrides this variable. ** Images --- -** Can explicitly specify base_uri for svg images. +*** You can explicitly specify base_uri for svg images. ':base-uri' image property can be used to explicitly specify base_uri -for embedded images into svg. ':base-uri' is supported for both file +for embedded images into svg. ':base-uri' is supported for both file and data svg images. +++ -** 'svg-embed-base-uri-image' added to embed images +*** 'svg-embed-base-uri-image' added to embed images. 'svg-embed-base-uri-image' can be used to embed images located relatively to 'file-name-directory' of the ':base-uri' svg image property. This works much faster then 'svg-embed'. @@ -1256,8 +1255,8 @@ project's root directory, respectively. So typing 'C-u RET' in the "*xref*" buffer quits its window before navigating to the selected location. -*** New options xref-search-program and xref-search-program-alist. -So far Grep and ripgrep are supported. ripgrep seems to offer better +*** New user options 'xref-search-program' and 'xref-search-program-alist'. +So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better performance in certain cases, in particular for case-insensitive searches. @@ -1442,9 +1441,8 @@ that makes it a valid button. ** Miscellaneous +++ - *** New variable 'current-minibuffer-command'. -This is like 'this-command', but is bound recursively when entering +This is like 'this-command', but it is bound recursively when entering the minibuffer. +++ @@ -1763,14 +1761,12 @@ used instead. * New Modes and Packages in Emacs 28.1 ** Lisp Data mode - The new command 'lisp-data-mode' enables a major mode for buffers composed of Lisp symbolic expressions that do not form a computer program. The ".dir-locals.el" file is automatically set to use this mode, as are other data files produced by Emacs. ** hierarchy.el - It's a library to create, query, navigate and display hierarchy structures. ** New themes 'modus-vivendi' and 'modus-operandi'. @@ -1781,13 +1777,12 @@ Consult the Modus Themes Info manual for more information on the user options they provide. ** Dictionary mode - -This is a mode for searching a RFC 2229 dictionary -server. 'dictionary' opens a buffer for starting -operations. 'dictionary-search' performs a lookup for a word. It also -supports a 'dictionary-tooltip-mode' which performs a lookup of the -word under the mouse in 'dictionary-tooltip-dictionary' (which must be -customized first). +This is a mode for searching a RFC 2229 dictionary server. +'dictionary' opens a buffer for starting operations. +'dictionary-search' performs a lookup for a word. It also supports a +'dictionary-tooltip-mode' which performs a lookup of the word under +the mouse in 'dictionary-tooltip-dictionary' (which must be customized +first). * Incompatible Editing Changes in Emacs 28.1 @@ -1939,7 +1934,7 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. * Lisp Changes in Emacs 28.1 -** New function `garbage-collect-maybe` to trigger GC early +** New function 'garbage-collect-maybe' to trigger GC early. --- ** 'defvar' detects the error of defining a variable currently lexically bound. @@ -2164,6 +2159,20 @@ and 'play-sound-file'. If this variable is non-nil, character syntax is used for printing numbers when this makes sense, such as '?A' for 65. +** New error 'remote-file-error', a subcategory of 'file-error'. +It is signaled if a remote file operation fails due to internal +reasons, and could block Emacs. It does not replace 'file-error' +signals for the usual cases. Timers, process filters and process +functions, which run remote file operations, shall protect themselves +against this error. + +If such an error occurs, please report this as bug via 'M-x report-emacs-bug'. +Until it is solved you could ignore such errors by performing + + (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) + +** The error 'ftp-error' belongs also to category 'remote-file-error'. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index c627e1a088d..1922adb5480 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1080,7 +1080,7 @@ All HOST values should be in lower case.") (defvar ange-ftp-trample-marker) ;; New error symbols. -(define-error 'ftp-error nil 'file-error) ;"FTP error" +(define-error 'ftp-error nil '(remote-file-error file-error)) ;"FTP error" ;;; ------------------------------------------------------------ ;;; Enhanced message support. diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 622116d9f90..9b6250430a8 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -159,9 +159,6 @@ When called interactively, a Tramp connection has to be selected." This includes password cache, file cache, connection cache, buffers." (interactive) - ;; Unlock Tramp. - (setq tramp-locked nil) - ;; Flush password cache. (password-reset) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b44eabcfa8b..4c8d37d602c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -348,6 +348,11 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) +;; Error symbol `remote-file-error' is defined in Emacs 28.1. We use +;; an adapted error message in order to see that compatible symbol. +(unless (get 'remote-file-error 'error-conditions) + (define-error 'remote-file-error "Remote file error (compat)" 'file-error)) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 34be4fcba93..e9814cdadb9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2944,7 +2944,8 @@ implementation will be used." (mapconcat #'tramp-shell-quote-argument uenv " ")) "") - (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") + (if heredoc + (format "<<'%s'" tramp-end-of-heredoc) "") (if tmpstderr (format "2>'%s'" tmpstderr) "") (mapconcat #'tramp-shell-quote-argument env " ") (if heredoc @@ -4914,7 +4915,8 @@ Goes through the list `tramp-inline-compress-commands'." (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." - (if (and tramp-locked tramp-locker + (if (and (tramp-get-connection-property + (tramp-get-connection-process vec) "locked" nil) (tramp-file-name-equal-p vec (car tramp-current-connection))) (progn (tramp-message @@ -4958,10 +4960,9 @@ connection if a previous connection has died for some reason." (when (and (time-less-p 60 (time-since (tramp-get-connection-property p "last-cmd-time" 0))) - (process-live-p p)) - (tramp-send-command vec "echo are you awake" t t) - (unless (and (process-live-p p) - (tramp-wait-for-output p 10)) + (process-live-p p) + (tramp-get-connection-property p "connected" nil)) + (unless (tramp-send-command-and-check vec "echo are you awake") ;; The error will be caught locally. (tramp-error vec 'file-error "Awake did fail"))) (file-error diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6750a7ff4c6..70bf1eee26b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2349,33 +2349,6 @@ Must be handled by the callers." res (cdr elt)))) res))) -;; In Emacs, there is some concurrency due to timers. If a timer -;; interrupts Tramp and wishes to use the same connection buffer as -;; the "main" Emacs, then garbage might occur in the connection -;; buffer. Therefore, we need to make sure that a timer does not use -;; the same connection buffer as the "main" Emacs. We implement a -;; cheap global lock, instead of locking each connection buffer -;; separately. The global lock is based on two variables, -;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true -;; (with setq) to indicate a lock. But Tramp also calls itself during -;; processing of a single file operation, so we need to allow -;; recursive calls. That's where the `tramp-locker' variable comes in -;; -- it is let-bound to t during the execution of the current -;; handler. So if `tramp-locked' is t and `tramp-locker' is also t, -;; then we should just proceed because we have been called -;; recursively. But if `tramp-locker' is nil, then we are a timer -;; interrupting the "main" Emacs, and then we signal an error. - -(defvar tramp-locked nil - "If non-nil, then Tramp is currently busy. -Together with `tramp-locker', this implements a locking mechanism -preventing reentrant calls of Tramp.") - -(defvar tramp-locker nil - "If non-nil, then a caller has locked Tramp. -Together with `tramp-locked', this implements a locking mechanism -preventing reentrant calls of Tramp.") - ;; Main function. (defun tramp-file-name-handler (operation &rest args) "Invoke Tramp file name handler for OPERATION and ARGS. @@ -2429,17 +2402,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (setq result (catch 'non-essential (catch 'suppress - (when (and tramp-locked (not tramp-locker)) - (setq tramp-locked nil) - (tramp-error - v 'file-error - "Forbidden reentrant call of Tramp")) - (let ((tl tramp-locked)) - (setq tramp-locked t) - (unwind-protect - (let ((tramp-locker t)) - (apply foreign operation args)) - (setq tramp-locked tl)))))) + (apply foreign operation args)))) ;; (tramp-message ;; v 4 "Running `%s'...`%s'" (cons operation args) result) (cond @@ -4499,6 +4462,32 @@ performed successfully. Any other value means an error." ;;; Utility functions: +;; In Emacs, there is some concurrency due to timers. If a timer +;; interrupts Tramp and wishes to use the same connection buffer as +;; the "main" Emacs, then garbage might occur in the connection +;; buffer. Therefore, we need to make sure that a timer does not use +;; the same connection buffer as the "main" Emacs. We lock each +;; connection process separately by a connection property. + +(defmacro with-tramp-locked-connection (proc &rest body) + "Lock PROC for other communication, and run BODY. +Mostly useful to protect BODY from being interrupted by timers." + (declare (indent 1) (debug t)) + `(if (tramp-get-connection-property ,proc "locked" nil) + ;; Be kind for older Emacsen. + (if (member 'remote-file-error debug-ignored-errors) + (throw 'non-essential 'non-essential) + (tramp-error + ,proc 'remote-file-error "Forbidden reentrant call of Tramp")) + (unwind-protect + (progn + (tramp-set-connection-property ,proc "locked" t) + ,@body) + (tramp-flush-connection-property ,proc "locked")))) + +(font-lock-add-keywords + 'emacs-lisp-mode '("\\")) + (defun tramp-accept-process-output (proc &optional timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set @@ -4508,15 +4497,17 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." (let ((inhibit-read-only t) last-coding-system-used result) - ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' - ;; returns t in order to report success. - (if (with-local-quit - (setq result (accept-process-output proc timeout nil t)) t) - (tramp-message - proc 10 "%s %s %s %s\n%s" - proc timeout (process-status proc) result (buffer-string)) - ;; Propagate quit. - (keyboard-quit)) + ;; This must be protected by the "locked" property. + (with-tramp-locked-connection proc + ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' + ;; returns t in order to report success. + (if (with-local-quit + (setq result (accept-process-output proc timeout nil t)) t) + (tramp-message + proc 10 "%s %s %s %s\n%s" + proc timeout (process-status proc) result (buffer-string)) + ;; Propagate quit. + (keyboard-quit))) result))) (defun tramp-search-regexp (regexp) @@ -4633,19 +4624,21 @@ the remote host use line-endings as defined in the variable (unless (or (string-empty-p string) (string-equal (substring string -1) tramp-rsh-end-of-line)) (setq string (concat string tramp-rsh-end-of-line))) - ;; Send the string. - (with-local-quit - (if (and chunksize (not (zerop chunksize))) - (let ((pos 0) - (end (length string))) - (while (< pos end) - (tramp-message - vec 10 "Sending chunk from %s to %s" - pos (min (+ pos chunksize) end)) - (process-send-string - p (substring string pos (min (+ pos chunksize) end))) - (setq pos (+ pos chunksize)))) - (process-send-string p string)))))) + ;; This must be protected by the "locked" property. + (with-tramp-locked-connection p + ;; Send the string. + (with-local-quit + (if (and chunksize (not (zerop chunksize))) + (let ((pos 0) + (end (length string))) + (while (< pos end) + (tramp-message + vec 10 "Sending chunk from %s to %s" + pos (min (+ pos chunksize) end)) + (process-send-string + p (substring string pos (min (+ pos chunksize) end))) + (setq pos (+ pos chunksize)))) + (process-send-string p string))))))) (defun tramp-process-sentinel (proc event) "Flush file caches and remove shell prompt." diff --git a/src/fileio.c b/src/fileio.c index 702c1438283..c97f4daf20c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6259,6 +6259,7 @@ syms_of_fileio (void) DEFSYM (Qfile_date_error, "file-date-error"); DEFSYM (Qfile_missing, "file-missing"); DEFSYM (Qfile_notify_error, "file-notify-error"); + DEFSYM (Qremote_file_error, "remote-file-error"); DEFSYM (Qexcl, "excl"); DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, @@ -6320,6 +6321,11 @@ behaves as if file names were encoded in `utf-8'. */); Fput (Qfile_notify_error, Qerror_message, build_pure_c_string ("File notification error")); + Fput (Qremote_file_error, Qerror_conditions, + Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror))); + Fput (Qremote_file_error, Qerror_message, + build_pure_c_string ("Remote file error")); + DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. If a file name matches REGEXP, all I/O on that file is done by calling diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 819a3dfecf5..0a5931d6893 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4817,6 +4817,7 @@ INPUT, if non-nil, is a string sent to the process." ;; this test cannot run properly. :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) + (skip-unless nil) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (skip-unless (not (tramp--test-crypt-p))) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. @@ -6236,15 +6237,14 @@ This is needed in timer functions as well as process filters and sentinels." "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - ;; The test fails from time to time, w/o a reproducible pattern. So - ;; we mark it as unstable. - :tags '(:expensive-test :unstable) + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-docker-p))) (with-timeout (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) @@ -6283,10 +6283,10 @@ process sentinels. They shall not disturb each other." ((getenv "EMACS_HYDRA_CI") 10) (t 1))) ;; We must distinguish due to performance reasons. - ;; (timer-operation - ;; (cond - ;; ((tramp--test-mock-p) #'vc-registered) - ;; (t #'file-attributes))) + (timer-operation + (cond + ((tramp--test-mock-p) #'vc-registered) + (t #'file-attributes))) ;; This is when all timers start. We check inside the ;; timer function, that we don't exceed timeout. (timer-start (current-time)) @@ -6314,10 +6314,15 @@ process sentinels. They shall not disturb each other." (default-directory tmp-name) (file (buffer-name - (nth (random (length buffers)) buffers)))) + (nth (random (length buffers)) buffers))) + ;; A remote operation in a timer could + ;; confuse Tramp heavily. So we ignore this + ;; error here. + (debug-ignored-errors + (cons 'remote-file-error debug-ignored-errors))) (tramp--test-message "Start timer %s %s" file (current-time-string)) - ;; (funcall timer-operation file) + (funcall timer-operation file) (tramp--test-message "Stop timer %s %s" file (current-time-string)) ;; Adjust timer if it takes too much time. @@ -6618,14 +6623,12 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. -;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' ;; do not work properly for `nextcloud'. ;; * Implement `tramp-test31-interrupt-process' for `adb' and for ;; direct async processes. -;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote -;; file name operation cannot run in the timer. Remove `:unstable' tag? +;; * Fix `tramp-test44-threads'. (provide 'tramp-tests) From 5337211b9453c25ef1b35bcb33844059ea34a10a Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 14 Dec 2020 19:49:39 +0100 Subject: [PATCH 085/148] Make the emake error messages red * admin/emake: Colorize error messages. --- admin/emake | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100755 admin/emake diff --git a/admin/emake b/admin/emake new file mode 100755 index 00000000000..d794e1c4178 --- /dev/null +++ b/admin/emake @@ -0,0 +1,76 @@ +#!/bin/bash + +cores=1 + +# Determine the number of cores. +if [ -f /proc/cpuinfo ]; then + cores=$(($(egrep "^physical id|^cpu cores" /proc/cpuinfo |\ + awk '{ print $4; }' |\ + sed '$!N;s/\n/ /' |\ + uniq |\ + sed 's/^[0-9]*/+/'))) +fi + +make -j$cores "$@" 2>&1 | \ +sed -u 's# \.\./\.\./# # +s# \.\./# # +s#^Configuring local git # Configuring local git # +s#^Installing git hooks...# Installing git hooks...# +s#^Running # Running # +s#^Configured for # Configured for # +s#^./temacs # ./temacs # +s#^Dumping under the name# Dumping under the name# +' | \ +egrep --line-buffered -v "^make|\ +^Loading|\ +SCRAPE|\ +INFO.*Scraping.*[.]\$|\ +^Waiting for git|\ +^Finding pointers|\ +^Using load-path|\ +^Adding name|\ +^Dump mode|\ +^Dumping finger|\ +^Byte counts|\ +^Reloc counts|\ +^Pure-hashed|\ +^cp -f temacs|\ +^rm -f bootstrap|\ +^Dump complete|\ +^rm -f emacs|\ +mkdir -p etc|\ +mkdir -p info|\ +mkdir -p lisp|\ +^LC_ALL.*pdump|\ +^cp -f emacs.p|\ +GEN.*loaddefs|\ +^Reloading stale|\ +^Source file.*newer than|\ +^Directories for loaddefs|\ +^./autogen.sh|\ +^[Cc]hecking |\ +^.Read INSTALL.REPO for more|\ +^Your system has the required tools.|\ +^Building aclocal.m4|\ +^ Running 'autoreconf|\ +^You can now run './configure'|\ +^./configure|\ +^configure: creating|\ +^\"configure\" file built.|\ +^There seems to be no|\ +^config.status:|\ +^ *$|\ +^Makefile built|\ +The GNU allocators don't work|\ +^git config |\ +^'\.git/|\ +^\^\(\(|\ +^'build-aux/git-hooks\ +" | \ +while read +do + C="" + [[ "X${REPLY:0:1}" != "X " ]] && C="\033[1;31m" + [[ "X${REPLY:0:3}" == "X " ]] && C="\033[1;31m" + [[ "X$C" == "X" ]] && printf "%s\n" "$REPLY" || printf "$C%s\033[0m\n" "$REPLY" +done From cd81739af17406cad0eb121cd979350e45cd1b92 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 14 Dec 2020 19:54:29 +0100 Subject: [PATCH 086/148] Add some admin/emake comments --- admin/emake | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/admin/emake b/admin/emake index d794e1c4178..d9aa4ea74bd 100755 --- a/admin/emake +++ b/admin/emake @@ -1,5 +1,14 @@ #!/bin/bash +# This script is meant to be used as ./admin/emake, and will compile +# the Emacs tree with virtually all of the informational messages +# removed, and with errors/warnings highlighted in red. It'll give a +# quick overview to confirm that nothing has broken, for instance +# after doing a "git pull". It's not meant to be used during actual +# development, because it removes so much information that commands +# like `next-error' won't be able to jump to the source code where +# errors are. + cores=1 # Determine the number of cores. From 9022df70270243f211c54ccd66800320148b8434 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 14 Dec 2020 19:38:52 +0000 Subject: [PATCH 087/148] Optimise c-parse-state for large buffers with few (if any) braces. * lisp/progmodes/cc-engine (c-get-fallback-scan-pos): Search a maximum of 50,000 characters back for the two BODs. Return nil if we dont' find them. (c-parse-state-get-strategy): For strategy `forward', always use the position `good-pos' for `start-point', even when there's a change of current macro. Deal with a possible return value of nil from c-get-fallback-scan-pos (as above). (c-invalidate-state-cache-1): For `c-state-cache-good-pos', instead of sometimes using the minimum scan pos (leading to extensive scanning of the entire buffer) use a point close to `here'. --- lisp/progmodes/cc-engine.el | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f14ffb38cde..68dadcc2724 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -3568,15 +3568,19 @@ mhtml-mode." ;; Return a start position for building `c-state-cache' from ;; scratch. This will be at the top level, 2 defuns back. (save-excursion - ;; Go back 2 bods, but ignore any bogus positions returned by - ;; beginning-of-defun (i.e. open paren in column zero). - (goto-char here) - (let ((cnt 2)) - (while (not (or (bobp) (zerop cnt))) - (c-beginning-of-defun-1) ; Pure elisp BOD. - (if (eq (char-after) ?\{) - (setq cnt (1- cnt))))) - (point))) + (save-restriction + (when (> here (* 10 c-state-cache-too-far)) + (narrow-to-region (- here (* 10 c-state-cache-too-far)) here)) + ;; Go back 2 bods, but ignore any bogus positions returned by + ;; beginning-of-defun (i.e. open paren in column zero). + (goto-char here) + (let ((cnt 2)) + (while (not (or (bobp) (zerop cnt))) + (c-beginning-of-defun-1) ; Pure elisp BOD. + (if (eq (char-after) ?\{) + (setq cnt (1- cnt))))) + (and (not (bobp)) + (point))))) (defun c-state-balance-parens-backwards (here- here+ top) ;; Return the position of the opening paren/brace/bracket before HERE- which @@ -3667,9 +3671,7 @@ mhtml-mode." how-far 0)) ((<= good-pos here) (setq strategy 'forward - start-point (if changed-macro-start - cache-pos - (max good-pos cache-pos)) + start-point (max good-pos cache-pos) how-far (- here start-point))) ((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting. (setq strategy 'backward @@ -3688,7 +3690,8 @@ mhtml-mode." ;; (not (c-major-mode-is 'c++-mode)) (> how-far c-state-cache-too-far)) (setq BOD-pos (c-get-fallback-scan-pos here)) ; somewhat EXPENSIVE!!! - (if (< (- here BOD-pos) how-far) + (if (and BOD-pos + (< (- here BOD-pos) how-far)) (setq strategy 'BOD start-point BOD-pos))) @@ -4337,8 +4340,12 @@ mhtml-mode." (if (and dropped-cons (<= too-high-pa here)) (c-append-lower-brace-pair-to-state-cache too-high-pa here here-bol)) - (setq c-state-cache-good-pos (or (c-state-cache-after-top-paren) - (c-state-get-min-scan-pos))))) + (if (and c-state-cache-good-pos (< here c-state-cache-good-pos)) + (setq c-state-cache-good-pos + (or (save-excursion + (goto-char here) + (c-literal-start)) + here))))) ;; The brace-pair desert marker: (when (car c-state-brace-pair-desert) From ee6c702e1895d88ee7e6f57bc6778694239ead76 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Tue, 10 Nov 2020 12:54:50 +0000 Subject: [PATCH 088/148] Fix error with fn key in NS port (bug#44533) * src/nsterm.m ([EmacsView keyDown:]): Move the correction for fn key handling to before the modifiers are calculated. (cherry picked from commit 7970610d48701a949ce443c94c71eac47d044197) --- src/nsterm.m | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index 4defeee7c3a..af06968d088 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6350,6 +6350,14 @@ not_in_argv (NSString *arg) code = 0xFF08; /* backspace */ else code = fnKeysym; + + /* Function keys (such as the F-keys, arrow keys, etc.) set + modifiers as though the fn key has been pressed when it + hasn't. Also some combinations of fn and a function key + return a different key than was pressed (e.g. fn- + gives ). We need to unset the fn key flag in these + cases. */ + flags &= ~NS_FUNCTION_KEY_MASK; } /* The ⌘ and ⌥ modifiers can be either shift-like (for alternate @@ -6371,17 +6379,6 @@ not_in_argv (NSString *arg) Lisp_Object kind = fnKeysym ? QCfunction : QCordinary; emacs_event->modifiers = EV_MODIFIERS2 (flags, kind); - /* Function keys (such as the F-keys, arrow keys, etc.) set - modifiers as though the fn key has been pressed when it - hasn't. Also some combinations of fn and a function key - return a different key than was pressed (e.g. fn- gives - ). We need to unset the fn modifier in these cases. - FIXME: Can we avoid setting it in the first place? */ - if (fnKeysym && (flags & NS_FUNCTION_KEY_MASK)) - emacs_event->modifiers - ^= parse_solitary_modifier (mod_of_kind (ns_function_modifier, - QCfunction)); - if (NS_KEYLOG) fprintf (stderr, "keyDown: code =%x\tfnKey =%x\tflags = %x\tmods = %x\n", code, fnKeysym, flags, emacs_event->modifiers); From 071bfd9840b1048bdc4f2c461fe50bd33dc919e8 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 14 Dec 2020 20:44:33 +0000 Subject: [PATCH 089/148] Optimise c-font-lock-<>-arglists, particularly for buffers with few <..> pairs * lisp/progmodes/cc-fonts.el (c-font-lock-<>-arglists): In place of a regexp search for a complicated and slow regexp, search simply for "<" ouside of literals together with add hoc testing of other requirements for a <...> match. * lisp/progmodes/cc-langs.el (c-nonsymbol-key): New c-lang-defvar from the c-lang-const. --- lisp/progmodes/cc-fonts.el | 111 ++++++++++++++++++++----------------- lisp/progmodes/cc-langs.el | 1 + 2 files changed, 61 insertions(+), 51 deletions(-) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index bb7e5bea6e6..38166c27ec8 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1008,66 +1008,75 @@ casts and declarations are fontified. Used on level 2 and higher." (boundp 'parse-sexp-lookup-properties))) (c-parse-and-markup-<>-arglists t) c-restricted-<>-arglists - id-start id-end id-face pos kwd-sym) + id-start id-end id-face pos kwd-sym + old-pos) (while (and (< (point) limit) - (re-search-forward c-opt-<>-arglist-start limit t)) + (setq old-pos (point)) + (c-syntactic-re-search-forward "<" limit t nil t)) + (setq pos (point)) + (save-excursion + (backward-char) + (c-backward-syntactic-ws old-pos) + (if (re-search-backward + (concat "\\(\\`\\|" c-nonsymbol-key "\\)\\(" c-symbol-key"\\)\\=") + old-pos t) + (setq id-start (match-beginning 2) + id-end (match-end 2)) + (setq id-start nil id-end nil))) - (setq id-start (match-beginning 1) - id-end (match-end 1) - pos (point)) + (when id-start + (goto-char id-start) + (unless (c-skip-comments-and-strings limit) + (setq kwd-sym nil + c-restricted-<>-arglists nil + id-face (get-text-property id-start 'face)) - (goto-char id-start) - (unless (c-skip-comments-and-strings limit) - (setq kwd-sym nil - c-restricted-<>-arglists nil - id-face (get-text-property id-start 'face)) + (if (cond + ((eq id-face 'font-lock-type-face) + ;; The identifier got the type face so it has already been + ;; handled in `c-font-lock-declarations'. + nil) - (if (cond - ((eq id-face 'font-lock-type-face) - ;; The identifier got the type face so it has already been - ;; handled in `c-font-lock-declarations'. - nil) + ((eq id-face 'font-lock-keyword-face) + (when (looking-at c-opt-<>-sexp-key) + ;; There's a special keyword before the "<" that tells + ;; that it's an angle bracket arglist. + (setq kwd-sym (c-keyword-sym (match-string 2))))) - ((eq id-face 'font-lock-keyword-face) - (when (looking-at c-opt-<>-sexp-key) - ;; There's a special keyword before the "<" that tells - ;; that it's an angle bracket arglist. - (setq kwd-sym (c-keyword-sym (match-string 1))))) + (t + ;; There's a normal identifier before the "<". If we're not in + ;; a declaration context then we set `c-restricted-<>-arglists' + ;; to avoid recognizing templates in function calls like "foo (a + ;; < b, c > d)". + (c-backward-syntactic-ws) + (when (and (memq (char-before) '(?\( ?,)) + (not (eq (get-text-property (1- (point)) 'c-type) + 'c-decl-arg-start))) + (setq c-restricted-<>-arglists t)) + t)) - (t - ;; There's a normal identifier before the "<". If we're not in - ;; a declaration context then we set `c-restricted-<>-arglists' - ;; to avoid recognizing templates in function calls like "foo (a - ;; < b, c > d)". - (c-backward-syntactic-ws) - (when (and (memq (char-before) '(?\( ?,)) - (not (eq (get-text-property (1- (point)) 'c-type) - 'c-decl-arg-start))) - (setq c-restricted-<>-arglists t)) - t)) + (progn + (goto-char (1- pos)) + ;; Check for comment/string both at the identifier and + ;; at the "<". + (unless (c-skip-comments-and-strings limit) - (progn - (goto-char (1- pos)) - ;; Check for comment/string both at the identifier and - ;; at the "<". - (unless (c-skip-comments-and-strings limit) + (c-fontify-types-and-refs () + (when (c-forward-<>-arglist (c-keyword-member + kwd-sym 'c-<>-type-kwds)) + (when (and c-opt-identifier-concat-key + (not (get-text-property id-start 'face))) + (c-forward-syntactic-ws) + (cond ((looking-at c-opt-identifier-concat-key) + (c-put-font-lock-face id-start id-end + c-reference-face-name)) + ((eq (char-after) ?\()) + (t (c-put-font-lock-face id-start id-end + 'font-lock-type-face)))))) - (c-fontify-types-and-refs () - (when (c-forward-<>-arglist (c-keyword-member - kwd-sym 'c-<>-type-kwds)) - (when (and c-opt-identifier-concat-key - (not (get-text-property id-start 'face))) - (c-forward-syntactic-ws) - (cond ((looking-at c-opt-identifier-concat-key) - (c-put-font-lock-face id-start id-end - c-reference-face-name)) - ((eq (char-after) ?\()) - (t (c-put-font-lock-face id-start id-end - 'font-lock-type-face)))))) - - (goto-char pos))) - (goto-char pos)))))) + (goto-char pos))) + (goto-char pos))))))) nil) (defun c-font-lock-declarators (limit list types not-top diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index d6089ea2950..4d1aeaa5cb9 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -699,6 +699,7 @@ It's assumed to not contain any submatchers." ;; The same thing regarding Unicode identifiers applies here as to ;; `c-symbol-key'. t (concat "[" (c-lang-const c-nonsymbol-chars) "]")) +(c-lang-defvar c-nonsymbol-key (c-lang-const c-nonsymbol-key)) (c-lang-defconst c-identifier-ops "The operators that make up fully qualified identifiers. nil in From 485898c18b8ce665a6539ad6be6ccf1b8bece0c6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 14 Dec 2020 16:16:01 -0500 Subject: [PATCH 090/148] * lisp/emacs-lisp/gv.el (error): Allow it as a place --- lisp/emacs-lisp/gv.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 5470b8532fc..7ee5c47d116 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -504,6 +504,11 @@ The return value is the last VAL in the list. (funcall do `(funcall (car ,gv)) (lambda (v) `(funcall (cdr ,gv) ,v)))))))) +(put 'error 'gv-expander + (lambda (do &rest args) + (funcall do `(error . ,args) + (lambda (v) `(progn ,v (error . ,args)))))) + (defmacro gv-synthetic-place (getter setter) "Special place described by its setter and getter. GETTER and SETTER (typically obtained via `gv-letplace') get and From 7e30cb2c1c2889965a1b1740905889a32f757461 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 14 Dec 2020 13:45:29 -0800 Subject: [PATCH 091/148] Tiny fix for lispref/variables.texi * doc/lispref/variables.texi (Converting to Lexical Binding): @strong{Note...} produces a spurious cross-reference in Info; reword to avoid that. --- doc/lispref/variables.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index b9ff0747382..9447e8d04c6 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1287,7 +1287,7 @@ be used.) @subsubheading Cross-file variable checking -@strong{Note:} This is an experimental feature that may change or +@strong{Caution:} This is an experimental feature that may change or disappear without prior notice. The byte-compiler can also warn about lexical variables that are From d148f1090fb53e5a360d316c89f241c839c44068 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 14 Dec 2020 13:46:35 -0800 Subject: [PATCH 092/148] * doc/emacs/indent.texi (Indent Convenience): Fix use of @xref. --- doc/emacs/indent.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index d6395ef155d..e8b46506335 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -255,7 +255,7 @@ indentation; otherwise, it inserts a tab character. indent can be further customized via the @code{tab-first-completion} variable. For instance, if that variable is @code{eol}, only complete if point is at the end of a line. @xref{Mode-Specific Indent,,, -elisp, The Emacs Lisp Reference Manual} for further details. +elisp, The Emacs Lisp Reference Manual}, for further details. @cindex Electric Indent mode @cindex mode, Electric Indent From fd4297b25a61b33340ef312355748512e702bc2c Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 14 Dec 2020 13:51:22 -0800 Subject: [PATCH 093/148] * doc/lispref/errors.texi (Standard Errors): Fix xref. Though I am not sure "report a bug" is helpful. --- doc/lispref/errors.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index ff9b3e57125..a386a41bd3d 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -135,8 +135,8 @@ problems in accessing a remote file. @xref{Remote Files,,, emacs, The GNU Emacs Manual}. Often, this error appears when timers, process filters, process sentinels or special events in general try to access a remote file, and collide with another remote file operation. In -general it is a good idea to write a bug report. @xref{Reporting -Bugs,,, emacs, The GNU Emacs Manual}. +general it is a good idea to write a bug report. +@xref{Bugs,,, emacs, The GNU Emacs Manual}. @c net/ange-ftp.el @item ftp-error From 3806797583a22ad520e64f7fc35d893840f0d563 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 15 Dec 2020 07:18:03 +0100 Subject: [PATCH 094/148] Bind current-minibuffer-command to this-command * src/callint.c (Fcall_interactively): Bind current-minibuffer-command to this-command, as documented (bug#45177). --- src/callint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/callint.c b/src/callint.c index a221705f676..d172af9e30b 100644 --- a/src/callint.c +++ b/src/callint.c @@ -286,7 +286,7 @@ invoke it (via an `interactive' spec that contains, for instance, an /* Bound recursively so that code can check the current command from code running from minibuffer hooks (and the like), without being overwritten by subsequent minibuffer calls. */ - specbind (Qcurrent_minibuffer_command, Vreal_this_command); + specbind (Qcurrent_minibuffer_command, Vthis_command); if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; From 8bc5bd5b03cfc1994734b5903f98dccc0cdf004f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 15 Dec 2020 08:43:41 +0100 Subject: [PATCH 095/148] Fix electric pairs in rst-mode * lisp/textmodes/rst.el (rst-mode-syntax-table): Mark pairs in the syntax table (bug#23413). (rst-mode): Instead of setting electric-pair-pairs. --- lisp/textmodes/rst.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 7a7ac478b76..435de2683ef 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1302,7 +1302,8 @@ This inherits from Text mode.") (modify-syntax-entry ?% "." st) (modify-syntax-entry ?& "." st) (modify-syntax-entry ?' "." st) - (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?` "\"` " st) + (modify-syntax-entry ?* "\"* " st) (modify-syntax-entry ?+ "." st) (modify-syntax-entry ?- "." st) (modify-syntax-entry ?/ "." st) @@ -1330,7 +1331,6 @@ The hook for `text-mode' is run before this one." ;; Pull in variable definitions silencing byte-compiler. (require 'newcomment) -(defvar electric-pair-pairs) (defvar electric-indent-inhibit) ;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files @@ -1387,8 +1387,6 @@ highlighting. (setq-local comment-region-function #'rst-comment-region) (setq-local uncomment-region-function #'rst-uncomment-region) - (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) - ;; Imenu and which function. ;; FIXME: Check documentation of `which-function' for alternative ways to ;; determine the current function name. From c8aad8cc11ccfda64a07cfc9675c6e6b07d552fa Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 15 Dec 2020 12:50:50 +0100 Subject: [PATCH 096/148] Revert last change in tramp-maybe-open-connection) * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Revert last change, it causes trouble. --- lisp/net/tramp-sh.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e9814cdadb9..f4a93c840cf 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4960,9 +4960,10 @@ connection if a previous connection has died for some reason." (when (and (time-less-p 60 (time-since (tramp-get-connection-property p "last-cmd-time" 0))) - (process-live-p p) - (tramp-get-connection-property p "connected" nil)) - (unless (tramp-send-command-and-check vec "echo are you awake") + (process-live-p p)) + (tramp-send-command vec "echo are you awake" t t) + (unless (and (process-live-p p) + (tramp-wait-for-output p 10)) ;; The error will be caught locally. (tramp-error vec 'file-error "Awake did fail"))) (file-error From 92c56300c317c9e5573dca787a2cf20f777b3179 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 15 Dec 2020 12:09:47 +0000 Subject: [PATCH 097/148] CC Mode: Optimize for scrolling large buffers containing few braces This fixes bug #25706. It particularly pertains to .h files which contain only macro definitions. Many of these files are to be found, for example, in the driver sections of the Linux kernel. * lisp/progmodes/cc-engine.el (c-beginning-of-statement-1, c-on-identifier) (c-syntactic-skip-backward, c-find-decl-prefix-search, c-find-decl-spots) (c-forward-name, c-back-over-list-of-member-inits) (c-back-over-member-initializers, c-looking-at-inexpr-block) (c-guess-basic-syntax): Give search limits to, or amend existing ones to c-backward-syntactic-ws, c-forward-syntactic-ws, c-backward-token-2, c-beginning-of-statement-1. (c-determine-limit-no-macro): New function. (c-determine-limit-get-base): Remove unlimted invocation of c-backward-syntactic-ws. (c-determine-limit): Exclude movement between two different macros. Use new function c-determine-limit-no-macro. (c-back-over-list-of-member-inits): New parameter `limit'. * lisp/progmodes/cc-fonts.el (c-font-lock-complex-decl-prepare) (c-font-lock-declarations, c-font-lock-c++-using): Give search limits to, or amend existing ones to c-backward-syntactic-ws, c-beginning-of-decl-1. * lisp/progmodes/cc-mode.el (c-unfind-coalesced-tokens, c-before-changer) (c-fl-decl-end): Give search limits to, or amend existing ones to c-backward-syntactic-ws, c-forward-syntactic-ws, skip-chars-backward, skip-chars-forward. --- lisp/progmodes/cc-engine.el | 282 +++++++++++++++++++++++------------- lisp/progmodes/cc-fonts.el | 16 +- lisp/progmodes/cc-mode.el | 33 +++-- 3 files changed, 212 insertions(+), 119 deletions(-) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 68dadcc2724..218bbb47cd5 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -972,7 +972,7 @@ comment at the start of cc-engine.el for more info." ;; that we've moved. (while (progn (setq pos (point)) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) ;; Protect post-++/-- operators just before a virtual semicolon. (and (not (c-at-vsemi-p)) (/= (skip-chars-backward "-+!*&~@`#") 0)))) @@ -984,7 +984,7 @@ comment at the start of cc-engine.el for more info." (if (and (memq (char-before) delims) (progn (forward-char -1) (setq saved (point)) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) (or (memq (char-before) delims) (memq (char-before) '(?: nil)) (eq (char-syntax (char-before)) ?\() @@ -1164,7 +1164,7 @@ comment at the start of cc-engine.el for more info." ;; HERE IS THE SINGLE PLACE INSIDE THE PDA LOOP WHERE WE MOVE ;; BACKWARDS THROUGH THE SOURCE. - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) (let ((before-sws-pos (point)) ;; The end position of the area to search for statement ;; barriers in this round. @@ -1174,33 +1174,35 @@ comment at the start of cc-engine.el for more info." ;; Go back over exactly one logical sexp, taking proper ;; account of macros and escaped EOLs. (while - (progn - (setq comma-delimited (and (not comma-delim) - (eq (char-before) ?\,))) - (unless (c-safe (c-backward-sexp) t) - ;; Give up if we hit an unbalanced block. Since the - ;; stack won't be empty the code below will report a - ;; suitable error. - (setq pre-stmt-found t) - (throw 'loop nil)) - (cond - ;; Have we moved into a macro? - ((and (not macro-start) - (c-beginning-of-macro)) - (save-excursion - (c-backward-syntactic-ws) - (setq before-sws-pos (point))) - ;; Have we crossed a statement boundary? If not, - ;; keep going back until we find one or a "real" sexp. - (and + (and + (progn + (setq comma-delimited (and (not comma-delim) + (eq (char-before) ?\,))) + (unless (c-safe (c-backward-sexp) t) + ;; Give up if we hit an unbalanced block. Since the + ;; stack won't be empty the code below will report a + ;; suitable error. + (setq pre-stmt-found t) + (throw 'loop nil)) + (cond + ;; Have we moved into a macro? + ((and (not macro-start) + (c-beginning-of-macro)) (save-excursion - (c-end-of-macro) - (not (c-crosses-statement-barrier-p - (point) maybe-after-boundary-pos))) - (setq maybe-after-boundary-pos (point)))) - ;; Have we just gone back over an escaped NL? This - ;; doesn't count as a sexp. - ((looking-at "\\\\$"))))) + (c-backward-syntactic-ws lim) + (setq before-sws-pos (point))) + ;; Have we crossed a statement boundary? If not, + ;; keep going back until we find one or a "real" sexp. + (and + (save-excursion + (c-end-of-macro) + (not (c-crosses-statement-barrier-p + (point) maybe-after-boundary-pos))) + (setq maybe-after-boundary-pos (point)))) + ;; Have we just gone back over an escaped NL? This + ;; doesn't count as a sexp. + ((looking-at "\\\\$")))) + (>= (point) lim))) ;; Have we crossed a statement boundary? (setq boundary-pos @@ -1413,7 +1415,7 @@ comment at the start of cc-engine.el for more info." ;; Skip over the unary operators that can start the statement. (while (progn - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) ;; protect AWK post-inc/decrement operators, etc. (and (not (c-at-vsemi-p (point))) (/= (skip-chars-backward "-.+!*&~@`#") 0))) @@ -4803,7 +4805,7 @@ comment at the start of cc-engine.el for more info." ;; Handle the "operator +" syntax in C++. (when (and c-overloadable-operators-regexp - (= (c-backward-token-2 0) 0)) + (= (c-backward-token-2 0 nil (c-determine-limit 500)) 0)) (cond ((and (looking-at c-overloadable-operators-regexp) (or (not c-opt-op-identifier-prefix) @@ -5072,7 +5074,8 @@ See `c-forward-token-2' for details." (while (and (> count 0) (progn - (c-backward-syntactic-ws) + (c-backward-syntactic-ws + limit) (backward-char) (if (looking-at jump-syntax) (goto-char (scan-sexps (1+ (point)) -1)) @@ -5409,8 +5412,12 @@ comment at the start of cc-engine.el for more info." ;; Optimize for, in particular, large blocks of comments from ;; `comment-region'. (progn (when opt-ws - (c-backward-syntactic-ws) - (setq paren-level-pos (point))) + (let ((opt-pos (point))) + (c-backward-syntactic-ws limit) + (if (or (null limit) + (> (point) limit)) + (setq paren-level-pos (point)) + (goto-char opt-pos)))) t) ;; Move back to a candidate end point which isn't in a literal ;; or in a macro we didn't start in. @@ -5430,7 +5437,11 @@ comment at the start of cc-engine.el for more info." (setq macro-start (point)))) (goto-char macro-start)))) (when opt-ws - (c-backward-syntactic-ws))) + (let ((opt-pos (point))) + (c-backward-syntactic-ws limit) + (if (and limit + (<= (point) limit)) + (goto-char opt-pos))))) (< (point) pos)) ;; Check whether we're at the wrong level of nesting (when @@ -5481,7 +5492,7 @@ comment at the start of cc-engine.el for more info." (progn ;; Skip syntactic ws afterwards so that we don't stop at the ;; end of a comment if `skip-chars' is something like "^/". - (c-backward-syntactic-ws) + (c-backward-syntactic-ws limit) (point))))) ;; We might want to extend this with more useful return values in @@ -5769,12 +5780,23 @@ comment at the start of cc-engine.el for more info." (t 'c))) ; Assuming the range is valid. range)) +(defun c-determine-limit-no-macro (here org-start) + ;; If HERE is inside a macro, and ORG-START is not also in the same macro, + ;; return the beginning of the macro. Otherwise return HERE. Point is not + ;; preserved by this function. + (goto-char here) + (let ((here-BOM (and (c-beginning-of-macro) (point)))) + (if (and here-BOM + (not (eq (progn (goto-char org-start) + (and (c-beginning-of-macro) (point))) + here-BOM))) + here-BOM + here))) + (defsubst c-determine-limit-get-base (start try-size) ;; Get a "safe place" approximately TRY-SIZE characters before START. ;; This defsubst doesn't preserve point. (goto-char start) - (c-backward-syntactic-ws) - (setq start (point)) (let* ((pos (max (- start try-size) (point-min))) (s (c-semi-pp-to-literal pos)) (cand (or (car (cddr s)) pos))) @@ -5783,20 +5805,23 @@ comment at the start of cc-engine.el for more info." (parse-partial-sexp pos start nil nil (car s) 'syntax-table) (point)))) -(defun c-determine-limit (how-far-back &optional start try-size) +(defun c-determine-limit (how-far-back &optional start try-size org-start) ;; Return a buffer position approximately HOW-FAR-BACK non-literal ;; characters from START (default point). The starting position, either ;; point or START may not be in a comment or string. ;; ;; The position found will not be before POINT-MIN and won't be in a - ;; literal. + ;; literal. It will also not be inside a macro, unless START/point is also + ;; in the same macro. ;; ;; We start searching for the sought position TRY-SIZE (default ;; twice HOW-FAR-BACK) bytes back from START. ;; ;; This function must be fast. :-) + (save-excursion (let* ((start (or start (point))) + (org-start (or org-start start)) (try-size (or try-size (* 2 how-far-back))) (base (c-determine-limit-get-base start try-size)) (pos base) @@ -5849,21 +5874,27 @@ comment at the start of cc-engine.el for more info." (setq elt (car stack) stack (cdr stack)) (setq count (+ count (cdr elt)))) - - ;; Have we found enough yet? (cond ((null elt) ; No non-literal characters found. - (if (> base (point-min)) - (c-determine-limit how-far-back base (* 2 try-size)) - (point-min))) + (cond + ((> pos start) ; Nothing but literals + base) + ((> base (point-min)) + (c-determine-limit how-far-back base (* 2 try-size) org-start)) + (t base))) ((>= count how-far-back) - (+ (car elt) (- count how-far-back))) + (c-determine-limit-no-macro + (+ (car elt) (- count how-far-back)) + org-start)) ((eq base (point-min)) (point-min)) ((> base (- start try-size)) ; Can only happen if we hit point-min. - (car elt)) + (c-determine-limit-no-macro + (car elt) + org-start)) (t - (c-determine-limit (- how-far-back count) base (* 2 try-size))))))) + (c-determine-limit (- how-far-back count) base (* 2 try-size) + org-start)))))) (defun c-determine-+ve-limit (how-far &optional start-pos) ;; Return a buffer position about HOW-FAR non-literal characters forward @@ -6255,8 +6286,14 @@ comment at the start of cc-engine.el for more info." ;; preceding syntactic ws to set `cfd-match-pos' and to catch ;; any decl spots in the syntactic ws. (unless cfd-re-match - (c-backward-syntactic-ws) - (setq cfd-re-match (point)))) + (let ((cfd-cbsw-lim + (max (- (point) 1000) (point-min)))) + (c-backward-syntactic-ws cfd-cbsw-lim) + (setq cfd-re-match + (if (or (bobp) (> (point) cfd-cbsw-lim)) + (point) + (point-min)))) ; Set BOB case if the token's too far back. + )) ;; Choose whichever match is closer to the start. (if (< cfd-re-match cfd-prop-match) @@ -6417,7 +6454,7 @@ comment at the start of cc-engine.el for more info." (while (and (not (bobp)) (c-got-face-at (1- (point)) c-literal-faces)) (goto-char (previous-single-property-change - (point) 'face nil (point-min)))) + (point) 'face nil (point-min)))) ; No limit. FIXME, perhaps? 2020-12-07. ;; XEmacs doesn't fontify the quotes surrounding string ;; literals. @@ -6489,12 +6526,15 @@ comment at the start of cc-engine.el for more info." (c-invalidate-find-decl-cache cfd-start-pos) (setq syntactic-pos (point)) - (unless (eq syntactic-pos c-find-decl-syntactic-pos) + (unless + (eq syntactic-pos c-find-decl-syntactic-pos) ;; Don't have to do this if the cache is relevant here, ;; typically if the same line is refontified again. If ;; we're just some syntactic whitespace further down we can ;; still use the cache to limit the skipping. - (c-backward-syntactic-ws c-find-decl-syntactic-pos)) + (c-backward-syntactic-ws + (max (or c-find-decl-syntactic-pos (point-min)) + (- (point) 10000) (point-min)))) ;; If we hit `c-find-decl-syntactic-pos' and ;; `c-find-decl-match-pos' is set then we install the cached @@ -6620,7 +6660,8 @@ comment at the start of cc-engine.el for more info." ;; syntactic ws. (when (and cfd-match-pos (< cfd-match-pos syntactic-pos)) (goto-char syntactic-pos) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws + (min (+ (point) 2000) (point-max))) (and cfd-continue-pos (< cfd-continue-pos (point)) (setq cfd-token-pos (point)))) @@ -6661,7 +6702,8 @@ comment at the start of cc-engine.el for more info." ;; can't be nested, and that's already been done in ;; `c-find-decl-prefix-search'. (when (> cfd-continue-pos cfd-token-pos) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws + (min (+ (point) 2000) (point-max))) (setq cfd-token-pos (point))) ;; Continue if the following token fails the @@ -8269,7 +8311,8 @@ comment at the start of cc-engine.el for more info." ;; typically called from `c-forward-type' in this case, and ;; the caller only wants the top level type that it finds to ;; be promoted. - c-promote-possible-types) + c-promote-possible-types + (lim+ (c-determine-+ve-limit 500))) (while (and (looking-at c-identifier-key) @@ -8299,7 +8342,7 @@ comment at the start of cc-engine.el for more info." ;; Handle a C++ operator or template identifier. (goto-char id-end) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) (cond ((eq (char-before id-end) ?e) ;; Got "... ::template". (let ((subres (c-forward-name))) @@ -8329,13 +8372,13 @@ comment at the start of cc-engine.el for more info." (looking-at "::") (progn (goto-char (match-end 0)) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) (eq (char-after) ?*)) (progn (forward-char) t)))) (while (progn - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) (setq pos (point)) (looking-at c-opt-type-modifier-key)) (goto-char (match-end 1)))))) @@ -8345,7 +8388,7 @@ comment at the start of cc-engine.el for more info." (setq c-last-identifier-range (cons (point) (match-end 0))) (goto-char (match-end 0)) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) (setq pos (point) res 'operator))) @@ -8359,7 +8402,7 @@ comment at the start of cc-engine.el for more info." (setq c-last-identifier-range (cons id-start id-end))) (goto-char id-end) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) (setq pos (point) res t))) @@ -8375,7 +8418,7 @@ comment at the start of cc-engine.el for more info." ;; cases with tricky syntactic whitespace that aren't ;; covered in `c-identifier-key'. (goto-char (match-end 0)) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) t) ((and c-recognize-<>-arglists @@ -8384,7 +8427,7 @@ comment at the start of cc-engine.el for more info." (when (let (c-last-identifier-range) (c-forward-<>-arglist nil)) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) (unless (eq (char-after) ?\() (setq c-last-identifier-range nil) (c-add-type start (1+ pos))) @@ -8399,7 +8442,7 @@ comment at the start of cc-engine.el for more info." (when (and c-record-type-identifiers id-start) (c-record-ref-id (cons id-start id-end))) (forward-char 2) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws lim+) t) (when (and c-record-type-identifiers id-start @@ -8824,7 +8867,7 @@ comment at the start of cc-engine.el for more info." (or res (goto-char here)) res)) -(defmacro c-back-over-list-of-member-inits () +(defmacro c-back-over-list-of-member-inits (limit) ;; Go back over a list of elements, each looking like: ;; () , ;; or {} , (with possibly a <....> expressions @@ -8833,21 +8876,21 @@ comment at the start of cc-engine.el for more info." ;; a comma. If either of or bracketed is missing, ;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil ;; to 'done. This is not a general purpose macro! - '(while (eq (char-before) ?,) + `(while (eq (char-before) ?,) (backward-char) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws ,limit) (when (not (memq (char-before) '(?\) ?}))) (throw 'level nil)) (when (not (c-go-list-backward)) (throw 'done nil)) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws ,limit) (while (eq (char-before) ?>) (when (not (c-backward-<>-arglist nil)) (throw 'done nil)) - (c-backward-syntactic-ws)) + (c-backward-syntactic-ws ,limit)) (when (not (c-back-over-compound-identifier)) (throw 'level nil)) - (c-backward-syntactic-ws))) + (c-backward-syntactic-ws ,limit))) (defun c-back-over-member-initializers (&optional limit) ;; Test whether we are in a C++ member initializer list, and if so, go back @@ -8866,14 +8909,14 @@ comment at the start of cc-engine.el for more info." (catch 'done (setq level-plausible (catch 'level - (c-backward-syntactic-ws) + (c-backward-syntactic-ws limit) (when (memq (char-before) '(?\) ?})) (when (not (c-go-list-backward)) (throw 'done nil)) - (c-backward-syntactic-ws)) + (c-backward-syntactic-ws limit)) (when (c-back-over-compound-identifier) - (c-backward-syntactic-ws)) - (c-back-over-list-of-member-inits) + (c-backward-syntactic-ws limit)) + (c-back-over-list-of-member-inits limit) (and (eq (char-before) ?:) (save-excursion (c-backward-token-2) @@ -8887,14 +8930,14 @@ comment at the start of cc-engine.el for more info." (setq level-plausible (catch 'level (goto-char pos) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws limit) (when (not (c-back-over-compound-identifier)) (throw 'level nil)) - (c-backward-syntactic-ws) - (c-back-over-list-of-member-inits) + (c-backward-syntactic-ws limit) + (c-back-over-list-of-member-inits limit) (and (eq (char-before) ?:) (save-excursion - (c-backward-token-2) + (c-backward-token-2 nil nil limit) (not (looking-at c-:$-multichar-token-regexp))) (c-just-after-func-arglist-p))))) @@ -12023,7 +12066,7 @@ comment at the start of cc-engine.el for more info." (goto-char haskell-op-pos)) (while (and (eq res 'maybe) - (progn (c-backward-syntactic-ws) + (progn (c-backward-syntactic-ws lim) (> (point) closest-lim)) (not (bobp)) (progn (backward-char) @@ -12728,7 +12771,7 @@ comment at the start of cc-engine.el for more info." literal char-before-ip before-ws-ip char-after-ip macro-start in-macro-expr c-syntactic-context placeholder step-type tmpsymbol keyword injava-inher special-brace-list tmp-pos - containing-< + tmp-pos2 containing-< ;; The following record some positions for the containing ;; declaration block if we're directly within one: ;; `containing-decl-open' is the position of the open @@ -12794,7 +12837,7 @@ comment at the start of cc-engine.el for more info." (setq paren-state (cons containing-sexp paren-state) containing-sexp nil))) (setq lim (1+ containing-sexp)))) - (setq lim (point-min))) + (setq lim (c-determine-limit 1000))) ;; If we're in a parenthesis list then ',' delimits the ;; "statements" rather than being an operator (with the @@ -13036,7 +13079,9 @@ comment at the start of cc-engine.el for more info." ;; CASE 4: In-expression statement. C.f. cases 7B, 16A and ;; 17E. ((setq placeholder (c-looking-at-inexpr-block - (c-safe-position containing-sexp paren-state) + (or + (c-safe-position containing-sexp paren-state) + (c-determine-limit 1000 containing-sexp)) containing-sexp ;; Have to turn on the heuristics after ;; the point even though it doesn't work @@ -13161,7 +13206,8 @@ comment at the start of cc-engine.el for more info." ;; init lists can, in practice, be very large. ((save-excursion (when (and (c-major-mode-is 'c++-mode) - (setq placeholder (c-back-over-member-initializers))) + (setq placeholder (c-back-over-member-initializers + lim))) (setq tmp-pos (point)))) (if (= (c-point 'bosws) (1+ tmp-pos)) (progn @@ -13480,7 +13526,7 @@ comment at the start of cc-engine.el for more info." ;; CASE 5I: ObjC method definition. ((and c-opt-method-key (looking-at c-opt-method-key)) - (c-beginning-of-statement-1 nil t) + (c-beginning-of-statement-1 (c-determine-limit 1000) t) (if (= (point) indent-point) ;; Handle the case when it's the first (non-comment) ;; thing in the buffer. Can't look for a 'same return @@ -13553,7 +13599,16 @@ comment at the start of cc-engine.el for more info." (if (>= (point) indent-point) (throw 'not-in-directive t)) (setq placeholder (point))) - nil))))) + nil)) + (and macro-start + (not (c-beginning-of-statement-1 lim nil nil nil t)) + (setq placeholder + (let ((ps-top (car paren-state))) + (if (consp ps-top) + (progn + (goto-char (cdr ps-top)) + (c-forward-syntactic-ws indent-point)) + (point-min)))))))) ;; For historic reasons we anchor at bol of the last ;; line of the previous declaration. That's clearly ;; highly bogus and useless, and it makes our lives hard @@ -13602,31 +13657,47 @@ comment at the start of cc-engine.el for more info." (eq (char-before) ?<) (not (and c-overloadable-operators-regexp (c-after-special-operator-id lim)))) - (c-beginning-of-statement-1 (c-safe-position (point) paren-state)) + (c-beginning-of-statement-1 + (or + (c-safe-position (point) paren-state) + (c-determine-limit 1000))) (c-add-syntax 'template-args-cont (c-point 'boi))) ;; CASE 5Q: we are at a statement within a macro. - (macro-start - (c-beginning-of-statement-1 containing-sexp) + ((and + macro-start + (save-excursion + (prog1 + (not (eq (c-beginning-of-statement-1 + (or containing-sexp (c-determine-limit 1000)) + nil nil nil t) + nil))) + (setq placeholder (point)))) + (goto-char placeholder) (c-add-stmt-syntax 'statement nil t containing-sexp paren-state)) - ;;CASE 5N: We are at a topmost continuation line and the only + ;;CASE 5S: We are at a topmost continuation line and the only ;;preceding items are annotations. ((and (c-major-mode-is 'java-mode) (setq placeholder (point)) - (c-beginning-of-statement-1) + (c-beginning-of-statement-1 lim) (progn - (while (and (c-forward-annotation)) - (c-forward-syntactic-ws)) + (while (and (setq tmp-pos (point)) + (< (point) placeholder) + (c-forward-annotation)) + (c-forward-syntactic-ws) + (setq tmp-pos2 tmp-pos)) t) (prog1 (>= (point) placeholder) (goto-char placeholder))) - (c-add-syntax 'annotation-top-cont (c-point 'boi))) + (c-add-syntax 'annotation-top-cont (c-point 'boi tmp-pos2))) ;; CASE 5M: we are at a topmost continuation line (t - (c-beginning-of-statement-1 (c-safe-position (point) paren-state)) + (c-beginning-of-statement-1 + (or (c-safe-position (point) paren-state) + (c-determine-limit 1000))) (when (c-major-mode-is 'objc-mode) (setq placeholder (point)) (while (and (c-forward-objc-directive) @@ -13682,8 +13753,9 @@ comment at the start of cc-engine.el for more info." (setq tmpsymbol '(block-open . inexpr-statement) placeholder (cdr-safe (c-looking-at-inexpr-block - (c-safe-position containing-sexp - paren-state) + (or + (c-safe-position containing-sexp paren-state) + (c-determine-limit 1000 containing-sexp)) containing-sexp))) ;; placeholder is nil if it's a block directly in ;; a function arglist. That makes us skip out of @@ -13815,7 +13887,9 @@ comment at the start of cc-engine.el for more info." (setq placeholder (c-guess-basic-syntax)))) (setq c-syntactic-context placeholder) (c-beginning-of-statement-1 - (c-safe-position (1- containing-sexp) paren-state)) + (or + (c-safe-position (1- containing-sexp) paren-state) + (c-determine-limit 1000 (1- containing-sexp)))) (c-forward-token-2 0) (while (cond ((looking-at c-specifier-key) @@ -13849,7 +13923,8 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'brace-list-close (point)) (setq lim (or (save-excursion (and - (c-back-over-member-initializers) + (c-back-over-member-initializers + (c-determine-limit 1000)) (point))) (c-most-enclosing-brace state-cache (point)))) (c-beginning-of-statement-1 lim nil nil t) @@ -13882,7 +13957,8 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'brace-list-intro (point)) (setq lim (or (save-excursion (and - (c-back-over-member-initializers) + (c-back-over-member-initializers + (c-determine-limit 1000)) (point))) (c-most-enclosing-brace state-cache (point)))) (c-beginning-of-statement-1 lim nil nil t) @@ -13938,7 +14014,9 @@ comment at the start of cc-engine.el for more info." ;; CASE 16A: closing a lambda defun or an in-expression ;; block? C.f. cases 4, 7B and 17E. ((setq placeholder (c-looking-at-inexpr-block - (c-safe-position containing-sexp paren-state) + (or + (c-safe-position containing-sexp paren-state) + (c-determine-limit 1000 containing-sexp)) nil)) (setq tmpsymbol (if (eq (car placeholder) 'inlambda) 'inline-close @@ -14101,7 +14179,9 @@ comment at the start of cc-engine.el for more info." ;; CASE 17E: first statement in an in-expression block. ;; C.f. cases 4, 7B and 16A. ((setq placeholder (c-looking-at-inexpr-block - (c-safe-position containing-sexp paren-state) + (or + (c-safe-position containing-sexp paren-state) + (c-determine-limit 1000 containing-sexp)) nil)) (setq tmpsymbol (if (eq (car placeholder) 'inlambda) 'defun-block-intro diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 38166c27ec8..e403c49e398 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -947,7 +947,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; closest token before the region. (save-excursion (let ((pos (point))) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws (max (- (point) 500) (point-min))) (c-clear-char-properties (if (and (not (bobp)) (memq (c-get-char-property (1- (point)) 'c-type) @@ -969,7 +969,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; The declared identifiers are font-locked correctly as types, if ;; that is what they are. (let ((prop (save-excursion - (c-backward-syntactic-ws) + (c-backward-syntactic-ws (max (- (point) 500) (point-min))) (unless (bobp) (c-get-char-property (1- (point)) 'c-type))))) (when (memq prop '(c-decl-id-start c-decl-type-start)) @@ -1505,7 +1505,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Check we haven't missed a preceding "typedef". (when (not (looking-at c-typedef-key)) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws + (max (- (point) 1000) (point-min))) (c-backward-token-2) (or (looking-at c-typedef-key) (goto-char start-pos))) @@ -1545,8 +1546,10 @@ casts and declarations are fontified. Used on level 2 and higher." (c-backward-token-2) (and (not (looking-at c-opt-<>-sexp-key)) - (progn (c-backward-syntactic-ws) - (memq (char-before) '(?\( ?,))) + (progn + (c-backward-syntactic-ws + (max (- (point) 1000) (point-min))) + (memq (char-before) '(?\( ?,))) (not (eq (c-get-char-property (1- (point)) 'c-type) 'c-decl-arg-start)))))) @@ -2304,7 +2307,8 @@ need for `c-font-lock-extra-types'.") (and c-colon-type-list-re (c-go-up-list-backward) (eq (char-after) ?{) - (eq (car (c-beginning-of-decl-1)) 'same) + (eq (car (c-beginning-of-decl-1 + (c-determine-limit 1000))) 'same) (looking-at c-colon-type-list-re))) ;; Inherited protected member: leave unfontified ) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 5e8cf6161ef..7a111017074 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -499,11 +499,14 @@ preferably use the `c-mode-menu' language constant directly." (save-excursion (when (< beg end) (goto-char beg) + (let ((lim (c-determine-limit 1000)) + (lim+ (c-determine-+ve-limit 1000 end))) (when (and (not (bobp)) - (progn (c-backward-syntactic-ws) (eq (point) beg)) + (progn (c-backward-syntactic-ws lim) (eq (point) beg)) (/= (skip-chars-backward c-symbol-chars (1- (point))) 0) - (progn (goto-char beg) (c-forward-syntactic-ws) (<= (point) end)) + (progn (goto-char beg) (c-forward-syntactic-ws lim+) + (<= (point) end)) (> (point) beg) (goto-char end) (looking-at c-symbol-char-key)) @@ -514,14 +517,14 @@ preferably use the `c-mode-menu' language constant directly." (goto-char end) (when (and (not (eobp)) - (progn (c-forward-syntactic-ws) (eq (point) end)) + (progn (c-forward-syntactic-ws lim+) (eq (point) end)) (looking-at c-symbol-char-key) - (progn (c-backward-syntactic-ws) (>= (point) beg)) + (progn (c-backward-syntactic-ws lim) (>= (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-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 @@ -1996,7 +1999,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; We search for appropriate c-type properties "near" ;; the change. First, find an appropriate boundary ;; for this property search. - (let (lim + (let (lim lim-2 type type-pos marked-id term-pos (end1 @@ -2007,8 +2010,11 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (when (>= end1 beg) ; Don't hassle about changes entirely in ; comments. ;; Find a limit for the search for a `c-type' property + ;; Point is currently undefined. A `goto-char' somewhere is needed. (2020-12-06). + (setq lim-2 (c-determine-limit 1000 (point) ; that is wrong. FIXME!!! (2020-12-06) + )) (while - (and (/= (skip-chars-backward "^;{}") 0) + (and (/= (skip-chars-backward "^;{}" lim-2) 0) (> (point) (point-min)) (memq (c-get-char-property (1- (point)) 'face) '(font-lock-comment-face font-lock-string-face)))) @@ -2032,7 +2038,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (buffer-substring-no-properties (point) type-pos))) (goto-char end1) - (skip-chars-forward "^;{}") ; FIXME!!! loop for + (setq lim-2 (c-determine-+ve-limit 1000)) + (skip-chars-forward "^;{}" lim-2) ; FIXME!!! loop for ; comment, maybe (setq lim (point)) (setq term-pos @@ -2270,9 +2277,11 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; preserved. (goto-char pos) (let ((lit-start (c-literal-start)) + (lim (c-determine-limit 1000)) enclosing-attribute pos1) (unless lit-start - (c-backward-syntactic-ws) + (c-backward-syntactic-ws + lim) (when (setq enclosing-attribute (c-enclosing-c++-attribute)) (goto-char (car enclosing-attribute))) ; Only happens in C++ Mode. (when (setq pos1 (c-on-identifier)) @@ -2296,14 +2305,14 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (setq pos1 (c-on-identifier)) (goto-char pos1) (progn - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) (eq (char-before) ?\()) (c-fl-decl-end (1- (point)))) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) (point)))) (and (progn (c-forward-syntactic-ws lim) (not (eobp))) - (c-backward-syntactic-ws) + (c-backward-syntactic-ws lim) (point))))))))) (defun c-change-expand-fl-region (_beg _end _old-len) From f3e21483106cb3ff64adcf21d30c8327a23a3401 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 15 Dec 2020 19:19:43 +0200 Subject: [PATCH 098/148] Fix setting breakpoints in "M-x gdb" when a source file is missing * lisp/progmodes/gdb-mi.el (gdb-get-location): Fix control flow logic when "fullname" is not found. Unquote and unescape the full file name by calling gdb-mi--c-string-from-string. FLAG is a string, not a character. (Bug#15051) --- lisp/progmodes/gdb-mi.el | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 4c248f771cd..330a8511bab 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -3127,24 +3127,27 @@ See `def-gdb-auto-update-handler'." (concat "fullname=\\(" gdb--string-regexp "\\)")) (defun gdb-get-location (bptno line flag) - "Find the directory containing the relevant source file. -Put in buffer and place breakpoint icon." + "Glean name of source file using `gdb-source-file-regexp', and visit it. +Place breakpoint icon in its buffer." (goto-char (point-min)) (catch 'file-not-found - (if (re-search-forward gdb-source-file-regexp nil t) - (delete (cons bptno "File not found") gdb-location-alist) - ;; FIXME: Why/how do we use (match-string 1) when the search failed? - (push (cons bptno (match-string 1)) gdb-location-alist) - (gdb-resync) - (unless (assoc bptno gdb-location-alist) - (push (cons bptno "File not found") gdb-location-alist) - (message-box "Cannot find source file for breakpoint location. + (let (source-file) + (if (re-search-forward gdb-source-file-regexp nil t) + (progn + (setq source-file (gdb-mi--c-string-from-string (match-string 1))) + (delete (cons bptno "File not found") gdb-location-alist) + (push (cons bptno source-file) gdb-location-alist)) + (gdb-resync) + (unless (assoc bptno gdb-location-alist) + (push (cons bptno "File not found") gdb-location-alist) + (message-box "Cannot find source file for breakpoint location. Add directory to search path for source files using the GDB command, dir.")) - (throw 'file-not-found nil)) - (with-current-buffer (find-file-noselect (match-string 1)) - (gdb-init-buffer) - ;; only want one breakpoint icon at each location - (gdb-put-breakpoint-icon (eq flag ?y) bptno (string-to-number line))))) + (throw 'file-not-found nil)) + (with-current-buffer (find-file-noselect source-file) + (gdb-init-buffer) + ;; Only want one breakpoint icon at each location. + (gdb-put-breakpoint-icon (string-equal flag "y") bptno + (string-to-number line)))))) (add-hook 'find-file-hook 'gdb-find-file-hook) From 2e7402b760576b54a326fca593c948a73bc3d6d0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 15 Dec 2020 19:34:16 +0200 Subject: [PATCH 099/148] Fix C-n/C-p when a line starts with an image * src/xdisp.c (move_it_to): Handle the case where the second call to move_it_in_display_line_to under MOVE_TO_Y takes us farther from TO_CHARPOS than the first call. This fixes values returned by pos-visible-in-window-p and posn-at-point when the screen line starts with invisible text followed by an image. (Bug#9092) --- src/xdisp.c | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 699183f3f59..0fd5ec5ec56 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9957,7 +9957,27 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos { skip = skip2; if (skip == MOVE_POS_MATCH_OR_ZV) - reached = 7; + { + reached = 7; + /* If the last move_it_in_display_line_to call + took us away from TO_CHARPOS, back up to the + previous position, as it is a better + approximation of TO_CHARPOS. (Note that we + could have both positions after TO_CHARPOS or + both positions before it, due to bidi + reordering.) */ + if (IT_CHARPOS (*it) != to_charpos + && ((IT_CHARPOS (it_backup) > to_charpos) + == (IT_CHARPOS (*it) > to_charpos))) + { + int max_ascent = it->max_ascent; + int max_descent = it->max_descent; + + RESTORE_IT (it, &it_backup, backup_data); + it->max_ascent = max_ascent; + it->max_descent = max_descent; + } + } } } else From fda9a2bbfd3adcce046c03bee72ba848c61a3e29 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 16 Dec 2020 02:49:35 +0200 Subject: [PATCH 100/148] (flymake-diag-region): Fall back to (end-of-thing 'symbol) * lisp/progmodes/flymake.el (flymake-diag-region): Fall back to (end-of-thing 'symbol) (bug#29193). --- lisp/progmodes/flymake.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index efa7b2ffbf1..6c3e0a19819 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -437,7 +437,8 @@ region is invalid." (if (and col (cl-plusp col)) (let* ((beg (progn (forward-char (1- col)) (point))) - (sexp-end (ignore-errors (end-of-thing 'sexp))) + (sexp-end (or (ignore-errors (end-of-thing 'sexp)) + (ignore-errors (end-of-thing 'symbol)))) (end (or (and sexp-end (not (= sexp-end beg)) sexp-end) From d1b1a5c0e653c0cbc3d95759adf4822a60c21ed0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 16 Dec 2020 15:20:46 +0100 Subject: [PATCH 101/148] ; * lisp/play/5x5.el: Fix my last change. --- lisp/play/5x5.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 5ab1493c7a9..8538dd5d3e4 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -31,7 +31,7 @@ ;; o The code for updating the grid needs to be re-done. At the moment it ;; simply re-draws the grid every time a move is made. ;; -;; o Look into starting up the display with color. gamegrid.el looks +;; o Look into improving the display with color. gamegrid.el looks ;; interesting, perhaps that is the way to go? ;;; Thanks: From 6eb6357423dbef73079732206f5a71cec09eed41 Mon Sep 17 00:00:00 2001 From: "E. Choroba" Date: Tue, 15 Dec 2020 14:37:50 +0100 Subject: [PATCH 102/148] Update short docs in cperl-mode * lisp/progmodes/cperl-mode.el (cperl-short-docs): Update with some missing entries. (Bug#45254) --- lisp/progmodes/cperl-mode.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index ae839a66220..5cf40fe959a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -7260,6 +7260,7 @@ __DATA__ Ends program source. __FILE__ Current (source) filename. __LINE__ Current line in current source. __PACKAGE__ Current package. +__SUB__ Current sub. ARGV Default multi-file input filehandle. is a synonym for <>. ARGVOUT Output filehandle with -i flag. BEGIN { ... } Immediately executed (during compilation) piece of code. @@ -7525,14 +7526,17 @@ use PACKAGE [SYMBOL1, ...] Compile-time `require' with consequent `import'. prototype \\&SUB Returns prototype of the function given a reference. =head1 Top-level heading. =head2 Second-level heading. -=head3 Third-level heading (is there such?). +=head3 Third-level heading. +=head4 Fourth-level heading. =over [ NUMBER ] Start list. =item [ TITLE ] Start new item in the list. =back End list. =cut Switch from POD to Perl. =pod Switch from Perl to POD. -=begin Switch from Perl6 to POD. -=end Switch from POD to Perl6. +=begin formatname Start directly formatted region. +=end formatname End directly formatted region. +=for formatname text Paragraph in special format. +=encoding encodingname Encoding of the document. ") (defun cperl-switch-to-doc-buffer (&optional interactive) From 32d85e3079a8cdfb0f083b766f2fafd361ee6e00 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Tue, 15 Dec 2020 18:53:03 +0100 Subject: [PATCH 103/148] CPerl-mode: don't treat <<>> as starting a here-doc * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Detect the "<<>>" operator (Bug#42455). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-45255): Verify that <<>> does not start a HERE-doc. --- lisp/progmodes/cperl-mode.el | 3 ++- test/lisp/progmodes/cperl-mode-tests.el | 8 ++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5cf40fe959a..15987a3b9b1 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3694,13 +3694,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 ;; "\\)" - ((match-beginning 3) ; 2 + 1 + ((match-beginning 3) ; 2 + 1: found "<<", detect its type (setq b (point) tb (match-beginning 0) c (and ; not HERE-DOC (match-beginning 6) (save-match-data (or (looking-at "[ \t]*(") ; << function_call() + (looking-at ">>") ; <<>> operator (save-excursion ; 1 << func_name, or $foo << 10 (condition-case nil (progn diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 896160bb883..cb2d067a610 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -312,4 +312,12 @@ have a face property." (let ((code "{ $a- / $b } # /")) (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))) +(ert-deftest cperl-test-bug-45255 () + "Verify that \"<<>>\" is recognized as not starting a HERE-doc." + (let ((code (concat "while (<<>>) {\n" + " ...;\n" + "}\n"))) + ;; The yadda-yadda operator should not be in a string. + (should (equal (nth 8 (cperl-test-ppss code "\\.")) nil)))) + ;;; cperl-mode-tests.el ends here From 7cacf5da47d1f88bbaef07e10841d1f6bfe2e471 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 16 Dec 2020 19:17:58 +0100 Subject: [PATCH 104/148] Update to Org 9.4.3 Fix #45259 --- doc/misc/org.texi | 14 ++++++-------- lisp/org/org-macs.el | 10 ++++++++-- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 6 +----- lisp/org/ox-html.el | 2 +- 5 files changed, 18 insertions(+), 18 deletions(-) diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 29713f18bc2..7766b300c4f 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -4050,12 +4050,11 @@ replacement text. Here is an example: @lisp (setq org-link-abbrev-alist - '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") - ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h") - ("google" . "http://www.google.com/search?q=") - ("gmap" . "http://maps.google.com/maps?q=%s") - ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") - ("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\""))) + '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") + ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h") + ("duckduckgo" . "https://duckduckgo.com/?q=%s") + ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") + ("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\""))) @end lisp If the replacement text contains the string @samp{%s}, it is replaced with @@ -18285,8 +18284,7 @@ A note of warning: when @samp{cache} is used in a session, caching may cause unexpected results. When the caching mechanism tests for any source code changes, it does -not expand noweb style references (see @ref{Noweb Reference Syntax}). For -reasons why, see @uref{https://orgmode.org/list/86fvqqc8jb.fsf@@somewhere.org} +not expand noweb style references (see @ref{Noweb Reference Syntax}). The @samp{cache} header argument can have one of two values: @samp{yes} or @samp{no}. diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index f375c33d96a..506fba8aaf5 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -461,9 +461,15 @@ is selected, only the bare key is returned." ;; 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)) + (setq header-line-format nil) + (org-fit-window-to-buffer) + (unless (pos-visible-in-window-p (1- (point-max))) + (setq header-line-format "Use C-n, C-p or C-v to navigate.") + (setq allowed-keys (append allowed-keys '("\C-n" "\C-p" "\C-v")))) (let ((pressed (org--mks-read-key allowed-keys prompt))) + (while (and (member pressed '("\C-n" "\C-p" "\C-v"))) + (org-scroll (string-to-char pressed)) + (setq pressed (org--mks-read-key allowed-keys prompt))) (setq current (concat current pressed)) (cond ((equal pressed "\C-g") (user-error "Abort")) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 738dbd663c1..479ca460852 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.4.2")) + (let ((org-release "9.4.3")) 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.4.2")) + (let ((org-git-version "release_9.4.3")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 063d0449d29..1f7e434cefd 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -8,7 +8,7 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: https://orgmode.org -;; Version: 9.4.2 +;; Version: 9.4.3 ;; This file is part of GNU Emacs. ;; @@ -21214,8 +21214,4 @@ Started from `gnus-info-find-node'." (run-hooks 'org-load-hook) -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - ;;; org.el ends here diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index d2f24f5c6e4..1a466fb162b 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -300,7 +300,7 @@ property on the headline itself.") padding: 3px; border: 1px solid black; } - pre.src:hover:before { display: inline;} + pre.src:hover:before { display: inline; margin-top: 14px;} /* Languages per Org manual */ pre.src-asymptote:before { content: 'Asymptote'; } pre.src-awk:before { content: 'Awk'; } From 64fe805b193eb15026c4b20c1d47d8cebbfbe609 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 16 Dec 2020 21:14:40 +0200 Subject: [PATCH 105/148] Improve documentation of 'query-replace' * doc/emacs/search.texi (Query Replace): Add 'E' to the list of characters one can type at 'query-replace' prompt. (Bug#45273) --- doc/emacs/search.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 2e094f3ad92..de7adc08eba 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1758,6 +1758,7 @@ occurrence of @var{string}. When done, exit the recursive editing level with @kbd{C-M-c} to proceed to the next occurrence. @item e +@itemx E to edit the replacement string in the minibuffer. When you exit the minibuffer by typing @key{RET}, the minibuffer contents replace the current occurrence of the pattern. They also become the new From 67fb182cfa6afeb9e212c89d78caac9bd4a82f3a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 16 Dec 2020 23:19:46 +0200 Subject: [PATCH 106/148] Give affixation-function higher priority over annotation-function (bug#45234) * doc/lispref/minibuf.texi (Completion Variables) (Programmed Completion): Describe precedence rules of affixation-function and annotation-function. * lisp/minibuffer.el (completion-metadata) (completion-extra-properties): Describe precedence rules of affixation-function and annotation-function. (minibuffer-completion-help): First try to apply affixation-function, if there is no such function, try annotation-function. --- doc/lispref/minibuf.texi | 6 ++++-- lisp/minibuffer.el | 16 ++++++++++------ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 56bc0b8ab67..48f068ee604 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1803,7 +1803,8 @@ The value should be a function to add prefixes and suffixes to completions. This function must accept one argument, a list of completions, and should return such a list of completions where each element contains a list of three elements: a completion, -a prefix string, and a suffix string. +a prefix string, and a suffix string. This function takes priority +over @code{:annotation-function}. @item :exit-function The value should be a function to run after performing completion. @@ -1911,7 +1912,8 @@ completions. The function should take one argument, return such a list of @var{completions} where each element contains a list of three elements: a completion, a prefix which is displayed before the completion string in the @file{*Completions*} buffer, and -a suffix displayed after the completion string. +a suffix displayed after the completion string. This function +takes priority over @code{annotation-function}. @item display-sort-function The value should be a function for sorting completions. The function diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 456193d52e1..7d05f7704e9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -123,7 +123,8 @@ This metadata is an alist. Currently understood keys are: - `affixation-function': function to prepend/append a prefix/suffix to entries. Takes one argument (COMPLETIONS) and should return a list of completions with a list of three elements: completion, its prefix - and suffix. + and suffix. This function takes priority over `annotation-function' + when both are provided, so only this function is used. - `display-sort-function': function to sort entries in *Completions*. Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. @@ -1926,6 +1927,8 @@ These include: completions. The function must accept one argument, a list of completions, and return a list where each element is a list of three elements: a completion, a prefix and a suffix. + This function takes priority over `:annotation-function' + when both are provided, so only this function is used. `:exit-function': Function to run after completion is performed. @@ -2056,15 +2059,16 @@ variables.") (if sort-fun (funcall sort-fun completions) (sort completions 'string-lessp)))) - (when ann-fun + (cond + (aff-fun + (setq completions + (funcall aff-fun completions))) + (ann-fun (setq completions (mapcar (lambda (s) (let ((ann (funcall ann-fun s))) (if ann (list s ann) s))) - completions))) - (when aff-fun - (setq completions - (funcall aff-fun completions))) + completions)))) (with-current-buffer standard-output (setq-local completion-base-position From 922e43ad7db2145f2a93ba66401289e420c129a5 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 16 Dec 2020 23:27:11 +0200 Subject: [PATCH 107/148] Don't show minibuffer keybindings for suggestions in read-extended-command * lisp/simple.el (read-extended-command): Use 'affixation-function' instead of 'annotation-function'. (Bug#45035) (read-extended-command--affixation): New function created from 'read-extended-command--annotation'. --- lisp/simple.el | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 6059c23a14e..090162b973a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1958,22 +1958,27 @@ to get different commands to edit and resubmit." (lambda (string pred action) (if (and suggest-key-bindings (eq action 'metadata)) '(metadata - (annotation-function . read-extended-command--annotation) + (affixation-function . read-extended-command--affixation) (category . command)) (complete-with-action action obarray string pred))) #'commandp t nil 'extended-command-history))) -(defun read-extended-command--annotation (command-name) - (let* ((fun (and (stringp command-name) (intern-soft command-name))) - (binding (where-is-internal fun overriding-local-map t)) - (obsolete (get fun 'byte-obsolete-info)) - (alias (symbol-function fun))) - (cond ((symbolp alias) - (format " (%s)" alias)) - (obsolete - (format " (%s)" (car obsolete))) - ((and binding (not (stringp binding))) - (format " (%s)" (key-description binding)))))) +(defun read-extended-command--affixation (command-names) + (with-selected-window (or (minibuffer-selected-window) (selected-window)) + (mapcar + (lambda (command-name) + (let* ((fun (and (stringp command-name) (intern-soft command-name))) + (binding (where-is-internal fun overriding-local-map t)) + (obsolete (get fun 'byte-obsolete-info)) + (alias (symbol-function fun)) + (suffix (cond ((symbolp alias) + (format " (%s)" alias)) + (obsolete + (format " (%s)" (car obsolete))) + ((and binding (not (stringp binding))) + (format " (%s)" (key-description binding)))))) + (if suffix (list command-name suffix) command-name))) + command-names))) (defcustom suggest-key-bindings t "Non-nil means show the equivalent key-binding when M-x command has one. From c51d9140be18697fbff60233d68b18f2f682a3b9 Mon Sep 17 00:00:00 2001 From: Pankaj Jangid Date: Wed, 16 Dec 2020 23:34:20 +0100 Subject: [PATCH 108/148] Fix resetting of gnus-pick-line-number * lisp/gnus/gnus-sum.el (gnus-summary-read-group-1): Move setting gnus-pick-line-number from here (bug#45269)... (gnus-summary-prepare): To here. This ensures that the number is reset when regenerating the buffer, for instance when limiting it. --- lisp/gnus/gnus-sum.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9488b324878..16152e252a0 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4100,8 +4100,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The group was successfully selected. (t (gnus-set-global-variables) - (when (boundp 'gnus-pick-line-number) - (setq gnus-pick-line-number 0)) (when (boundp 'spam-install-hooks) (spam-initialize)) ;; Save the active value in effect when the group was entered. @@ -4226,6 +4224,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." gnus-newsgroup-data-reverse nil) (gnus-run-hooks 'gnus-summary-generate-hook) ;; Generate the buffer, either with threads or without. + (when (boundp 'gnus-pick-line-number) + (setq gnus-pick-line-number 0)) (when gnus-newsgroup-headers (gnus-summary-prepare-threads (if gnus-show-threads From 32d76c0cbc32aa8740bf742a0aea05dd92d28275 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 17 Dec 2020 12:17:23 +0100 Subject: [PATCH 109/148] Default the init file to init.el, not init * lisp/startup.el (startup--load-user-init-file): Make the default init file be "init.el", not "init" (bug#45197). --- lisp/startup.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index b652977798a..b1128f6d02a 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -949,10 +949,10 @@ init-file, or to a default value if loading is not possible." (when (and (eq user-init-file t) alternate-filename-function) (let ((alt-file (funcall alternate-filename-function))) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) (unless init-file-name (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) (load alt-file 'noerror 'nomessage))) ;; If we did not find the user's init file, set @@ -1382,7 +1382,7 @@ please check its value") "~/.emacs"))) (lambda () (expand-file-name - "init" + "init.el" startup-init-directory)) (not inhibit-default-init)) From 7fad9591142f9d9d0bfce37dd8c65a847dbe8aa9 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 17 Dec 2020 12:06:15 +0100 Subject: [PATCH 110/148] Ensure that byte compilation works for relative files (Bug#45287). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Don’t fail if target filename doesn’t contain a directory name. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--target-file-no-directory): New unit test. --- lisp/emacs-lisp/bytecomp.el | 6 +++++- test/lisp/emacs-lisp/bytecomp-tests.el | 15 +++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e23bb9f5e6e..64f2c010824 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1967,7 +1967,11 @@ See also `emacs-lisp-byte-compile-and-load'." ;; We attempt to create a temporary file in the ;; target directory, so the target directory must be ;; writable. - (file-writable-p (file-name-directory target-file))) + (file-writable-p + (file-name-directory + ;; Need to expand in case TARGET-FILE doesn't + ;; include a directory (Bug#45287). + (expand-file-name 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 diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index c2a3e3ba117..4a6e28f7c7c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1016,6 +1016,21 @@ mountpoint (Bug#44631)." (set-file-modes directory #o700) (delete-directory directory :recursive)))))) +(ert-deftest bytecomp-tests--target-file-no-directory () + "Check that Bug#45287 is fixed." + (let ((directory (make-temp-file "bytecomp-tests-" :directory))) + (unwind-protect + (let* ((default-directory directory) + (byte-compile-dest-file-function (lambda (_) "test.elc")) + (byte-compile-error-on-warn t)) + (write-region "" nil "test.el" nil nil nil 'excl) + (should (byte-compile-file "test.el")) + (should (file-regular-p "test.elc")) + (should (cl-plusp (file-attribute-size + (file-attributes "test.elc"))))) + (with-demoted-errors "Error cleaning up directory: %s" + (delete-directory directory :recursive))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: From 526abadd071e8c2cd67b91c2e282b44e01917fdb Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 17 Dec 2020 12:32:29 +0100 Subject: [PATCH 111/148] Fix fallback use of write-file in ido-mode * lisp/ido.el (ido-file-internal): Make `write-file' respect the directory we've navigated to (bug#28513). --- lisp/ido.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/ido.el b/lisp/ido.el index 5758d3fdeac..99241ce1a3a 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -2367,7 +2367,16 @@ If cursor is not at the end of the user input, move to end of input." (read-file-name-function nil)) (setq this-command (or ido-fallback fallback 'find-file)) (run-hook-with-args 'ido-before-fallback-functions this-command) - (call-interactively this-command))) + (if (eq this-command 'write-file) + (write-file (read-file-name + "Write file: " + default-directory + (and buffer-file-name + (expand-file-name + (file-name-nondirectory buffer-file-name) + default-directory))) + t) + (call-interactively this-command)))) ((eq ido-exit 'switch-to-buffer) (ido-buffer-internal From d7a4ceaa1e5d347e84d99c6b854b2144b32366b3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 17 Dec 2020 16:22:05 +0200 Subject: [PATCH 112/148] ; Add a new item to TODO * etc/TODO (redisplay): Add an item for making redisplay cycle more scalable when there are many frames. --- etc/TODO | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/etc/TODO b/etc/TODO index 152a29964f3..5c6a210f2d7 100644 --- a/etc/TODO +++ b/etc/TODO @@ -536,6 +536,42 @@ This should go with point, so that motion commands can also move through tall images. This value would be to point as window-vscroll is to window-start. +** Make redisplay smarter about which parts to redraw +Currently, redisplay has only 2 levels of redrawing: either it +redisplays only the selected window on the selected frame, or it +redisplays all the windows on all the frames. This doesn't scale well +when the number of visible frames is large. + +Currently, two variables are used to make the decision what to +redisplay: update_mode_lines and windows_or_buffers_changed. These +are set by various functions called from Lisp, and if redisplay finds +one of them to be non-zero, it considers all the windows on all the +frames for redisplay. + +The idea is to make the decision which parts need to be redrawn more +fine-grained. Instead of simple boolean variables, we could have a +bitmapped variable which records the kinds of changes done by Lisp +since the previous redisplay cycle. Then the decision what exactly +needs to be redrawn could be made based on the bits that are set. + +For example, one reason to consider all frames is that some scrolling +command sets the update_mode_lines variable non-zero. This is done +because the frame title, which doesn't belong to any window, needs to +be reconsidered when the selected window is scrolled. But considering +the frame title doesn't have to redisplay all the other windows on the +frame, doesn't need to recompute the menu items and the tool-bar +buttons, and doesn't need to consider frames other than the selected +one. Being selective about what parts of the Emacs display need to be +reconsidered and redrawn given the changes since the last redisplay +will go along way towards making redisplay more scalable. + +One way of making this change is to go through all the places that set +update_mode_lines and windows_or_buffers_changed, figure out which +portions of the Emacs display could be affected by each change, and +then implement the bitmap which will record each of these affected +display portions. The logic in redisplay_internal will then need to +be restructured so as to support this fine-grained redisplay. + ** Address internationalization of symbols names Essentially as if they were documentation, e.g. in command names and Custom. From 02c4f65a1ea5d55a569a559bb181c6df5171319b Mon Sep 17 00:00:00 2001 From: Zajcev Evgeny Date: Thu, 17 Dec 2020 11:27:20 +0300 Subject: [PATCH 113/148] Make "Invalid modifier in string" ordinary invalid-read-syntax error * src/lread.ec (read1): Raise "Invalid modifier in string" error as `invalid-read-syntax'. This fixes raise of unhandled error in `elisp--local-variables' --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index a3d5fd7bb81..3ef874039a6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3438,7 +3438,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Any modifiers remaining are invalid. */ if (modifiers) - error ("Invalid modifier in string"); + invalid_syntax ("Invalid modifier in string"); p += CHAR_STRING (ch, (unsigned char *) p); } else From d5941d8396a6bbe67bb06c339af008a5f688c73e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Dec 2020 11:53:56 -0500 Subject: [PATCH 114/148] Fix my two most common causes of all windows/frames redisplay * src/buffer.c (Fkill_all_local_variables): Only redisplay the buffer. * src/window.c (set_window_scroll_bars): Only redisplay the window. --- src/buffer.c | 2 +- src/window.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 4215acbf1df..dfc34faf6e6 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -2814,7 +2814,7 @@ the normal hook `change-major-mode-hook'. */) /* Force mode-line redisplay. Useful here because all major mode commands call this function. */ - update_mode_lines = 12; + bset_update_mode_line (current_buffer); return Qnil; } diff --git a/src/window.c b/src/window.c index 4eab786958f..bcc989b5a79 100644 --- a/src/window.c +++ b/src/window.c @@ -7822,7 +7822,7 @@ set_window_scroll_bars (struct window *w, Lisp_Object width, if more than a single window needs to be considered, see redisplay_internal. */ if (changed) - windows_or_buffers_changed = 31; + wset_redisplay (w); return changed ? w : NULL; } From d428cc1b927ae1bf8240ed30b37c9418e819381d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 17 Dec 2020 19:08:40 +0100 Subject: [PATCH 115/148] Remove incorrect comment from erc-goodies.el * lisp/erc/erc-goodies.el (erc-move-to-prompt-setup): Remove incorrect comment; the XEmacs compat code has been removed. --- lisp/erc/erc-button.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index b799b2427c6..cd04a3ab2c2 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -242,7 +242,6 @@ global-level ERC button keys yet.") (defun erc-button-setup () "Add ERC mode-level button movement keys. This is only done once." - ;; Make XEmacs use `erc-button-face'. ;; Add keys. (unless erc-button-keys-added (define-key erc-mode-map (kbd "") 'erc-button-previous) From ddff5d3d879d23f0684b8abe7d923fce4f86ec2e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 17 Dec 2020 18:52:23 +0100 Subject: [PATCH 116/148] Some minor Tramp changes * doc/lispref/os.texi (Timers): Speak about `remote-file-error'. * doc/misc/tramp.texi (Frequently Asked Questions): Speak about `remote-file-error'. (External packages): New subsection "Timers". * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Adapt error function. Handle coding. * lisp/net/tramp.el (tramp-handle-make-process): Adapt error function. --- doc/lispref/os.texi | 13 +++++++++++ doc/misc/tramp.texi | 52 +++++++++++++++++++++++++++++++++++++------ lisp/net/tramp-adb.el | 8 +++++-- lisp/net/tramp-sh.el | 13 +++++++++-- lisp/net/tramp.el | 2 +- 5 files changed, 76 insertions(+), 12 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index bc602205f5d..85f930d1897 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2106,6 +2106,19 @@ run while waiting. If a timer function needs to perform an action after a certain time has elapsed, it can do this by scheduling a new timer. + If a timer function performs a remote file operation, it can be in +conflict with an already running remote file operation of the same +connection. Such conflicts are detected, and they result in a +@code{remote-file-error} error (@pxref{Standard Errors}). This should +be protected by wrapping the timer function body with + +@lisp +@group +(ignore-error 'remote-file-error + @dots{}) +@end group +@end lisp + If a timer function calls functions that can change the match data, it should save and restore the match data. @xref{Saving Match Data}. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 59b8bdbdf37..0557ca54695 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2508,7 +2508,7 @@ whatever shell is installed on the device with this setting: @lisp @group (add-to-list 'tramp-connection-properties - (list (regexp-quote "192.168.0.26") "remote-shell" "sh")) + (list (regexp-quote "192.168.0.26") "remote-shell" "sh")) @end group @end lisp @@ -2560,7 +2560,7 @@ the previous example, fix the connection properties as follows: @lisp @group (add-to-list 'tramp-connection-properties - (list (regexp-quote "android") "remote-shell" "sh")) + (list (regexp-quote "android") "remote-shell" "sh")) @end group @end lisp @@ -4341,9 +4341,9 @@ configure @file{~/.ssh/config} on the proxy host: @example @group Host * - ControlMaster auto - ControlPath tramp.%C - ControlPersist no + ControlMaster auto + ControlPath tramp.%C + ControlPersist no @end group @end example @@ -4877,6 +4877,25 @@ In case you have installed it from its Git repository, @ref{Recompilation}. @end ifset +@item +I get an error @samp{Remote file error: Forbidden reentrant call of Tramp} + +Timers, process filters and sentinels, and other event based functions +can run at any time, when a remote file operation is still running. +This can cause @value{tramp} to block. When such a situation is +detected, this error is triggered. It shall be fixed in the +respective function (an error report will help), but for the time +being you can suppress this error by the following code in your +@file{~/.emacs}: + +@lisp +@group +(setq debug-ignored-errors + (cons 'remote-file-error debug-ignored-errors)) +@end group +@end lisp + + @item How to disable other packages from calling @value{tramp}? @@ -4982,7 +5001,7 @@ handlers. @node External packages @section Integrating with external Lisp packages -@subsection File name completion. +@subsection File name completion @vindex non-essential Sometimes, it is not convenient to open a new connection to a remote @@ -5000,7 +5019,7 @@ bind it to non-@code{nil} value. @end lisp -@subsection File attributes cache. +@subsection File attributes cache Keeping a local cache of remote file attributes in sync with the remote host is a time-consuming operation. Flushing and re-querying @@ -5040,6 +5059,25 @@ root-directory, it is most likely sufficient to make the @code{default-directory} of the process buffer as the root directory. +@subsection Timers + +Timers run asynchronously at any time when Emacs is waiting for +sending a string to a process, or waiting for process output. They +can run any remote file operation, which would conflict with the +already running remote file operation, if the same connection is +affected. @value{tramp} detects this situation, and raises the +@code{remote-file-error} error. A timer function shall avoid this +situation. At least, it shall protect itself against this error, by +wrapping the timer function body with + +@lisp +@group +(ignore-error 'remote-file-error + @dots{}) +@end group +@end lisp + + @node Traces and Profiles @chapter How to Customize Traces @vindex tramp-verbose diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index f6e89339b68..9ea72668e7b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -929,7 +929,7 @@ alternative implementation will be used." (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) + (signal 'wrong-type-argument (list #'bufferp stderr))) (when (and (stringp stderr) (tramp-tramp-file-p stderr) (not (tramp-equal-remote default-directory stderr))) (signal 'file-error (list "Wrong stderr" stderr))) @@ -981,7 +981,11 @@ alternative implementation will be used." ;; otherwise we might be interrupted by ;; `verify-visited-file-modtime'. (let ((buffer-undo-list t) - (inhibit-read-only t)) + (inhibit-read-only t) + (coding-system-for-write + (if (symbolp coding) coding (car coding))) + (coding-system-for-read + (if (symbolp coding) coding (cdr coding)))) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) ;; We call `tramp-adb-maybe-open-connection', diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f4a93c840cf..e30fe61de43 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2871,7 +2871,7 @@ implementation will be used." (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) + (signal 'wrong-type-argument (list #'bufferp stderr))) (when (and (stringp stderr) (tramp-tramp-file-p stderr) (not (tramp-equal-remote default-directory stderr))) (signal 'file-error (list "Wrong stderr" stderr))) @@ -2985,7 +2985,11 @@ implementation will be used." ;; `verify-visited-file-modtime'. (let ((buffer-undo-list t) (inhibit-read-only t) - (mark (point-max))) + (mark (point-max)) + (coding-system-for-write + (if (symbolp coding) coding (car coding))) + (coding-system-for-read + (if (symbolp coding) coding (cdr coding)))) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) ;; We call `tramp-maybe-open-connection', in @@ -6139,4 +6143,9 @@ function cell is returned to be applied on a buffer." ;; ;; * Implement `:stderr' of `make-process' as pipe process. +;; * One interesting solution (with other applications as well) would +;; be to stipulate, as a directory or connection-local variable, an +;; additional rc file on the remote machine that is sourced every +;; time Tramp connects. + ;;; tramp-sh.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 70bf1eee26b..a4865ec4f22 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3788,7 +3788,7 @@ It does not support `:stderr'." (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) + (signal 'wrong-type-argument (list #'bufferp stderr))) (let* ((buffer (if buffer From 5ada3eecec79703a84e2f2c38cae16ef4b2600cc Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Dec 2020 18:21:47 -0500 Subject: [PATCH 117/148] * lisp/org/org-refile.el (org-copy): Fix missing obsoletion version --- lisp/org/org-refile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 2a3fad53e80..9eab7e1edeb 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -373,7 +373,7 @@ the *old* location.") (defvar org-refile-keep nil "Non-nil means `org-refile' will copy instead of refile.") -(define-obsolete-function-alias 'org-copy 'org-refile-copy) +(define-obsolete-function-alias 'org-copy 'org-refile-copy "Org 9.4") ;;;###autoload (defun org-refile-copy () From fa4c2768cf6cf670e4c7af0c2b74ad139e65aad4 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 18 Dec 2020 04:05:18 +0200 Subject: [PATCH 118/148] flymake-diag-region: Fix the recent test breakage * lisp/progmodes/flymake.el (flymake-diag-region): Make sure to save the match data (bug#29193). --- lisp/progmodes/flymake.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 6c3e0a19819..da026da86a2 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -438,7 +438,8 @@ region is invalid." (let* ((beg (progn (forward-char (1- col)) (point))) (sexp-end (or (ignore-errors (end-of-thing 'sexp)) - (ignore-errors (end-of-thing 'symbol)))) + (save-match-data + (ignore-errors (end-of-thing 'symbol))))) (end (or (and sexp-end (not (= sexp-end beg)) sexp-end) From e3f83a89aa7da460615064390273c87844bdb0dc Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 17 Dec 2020 19:16:00 -0800 Subject: [PATCH 119/148] Fix regexp in IMAP search-string preparation * lisp/gnus/gnus-search.el (gnus-search-run-search): This was failing to catch all of X-GM-RAW. --- lisp/gnus/gnus-search.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 829e0fa3ad1..16f3a024aa6 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1071,7 +1071,7 @@ Responsible for handling and, or, and parenthetical expressions.") ;; A bit of backward-compatibility slash convenience: if the ;; query string doesn't start with any known IMAP search ;; keyword, assume it is a "TEXT" search. - (unless (and (string-match "\\`[[:word:]]+" q-string) + (unless (and (string-match "\\`[^ [:blank:]]+" q-string) (memql (intern-soft (downcase (match-string 0 q-string))) gnus-search-imap-search-keys)) From c5f2eb56c0164e87abc881955552e0b718921186 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 18 Dec 2020 10:24:48 +0100 Subject: [PATCH 120/148] Fix previous frame-focus server.el change * lisp/server.el (server-execute): Always give Emacs focus, whether we open a new frame or not. --- lisp/server.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index cd55d66a975..7773da09c76 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1327,6 +1327,8 @@ The following commands are accepted by the client: (t (server-return-error proc err)))) (defun server-execute (proc files nowait commands dontkill frame tty-name) + (when server-raise-frame + (select-frame-set-input-focus (or frame (selected-frame)))) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer ;; is run after 0s and the process-filter is run in response to the @@ -1334,8 +1336,6 @@ The following commands are accepted by the client: ;; inhibit-quit flag, which is good since `commands' (as well as ;; find-file-noselect via the major-mode) can run arbitrary code, ;; including code that needs to wait. - (when (and frame server-raise-frame) - (select-frame-set-input-focus frame)) (with-local-quit (condition-case err (let ((buffers (server-visit-files files proc nowait))) From 95eaf45ddfd6ea639c1d31ff7627c48601f74594 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 18 Dec 2020 11:29:28 +0000 Subject: [PATCH 121/148] Save match data in flymake-diag-region (bug#29193) * lisp/progmodes/flymake.el (flymake-diag-region): Move save-match-data up. --- lisp/progmodes/flymake.el | 68 +++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index da026da86a2..dfb4f18cff7 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -418,40 +418,40 @@ region is invalid." (let ((line (min (max line 1) (line-number-at-pos (point-max) 'absolute)))) (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (cl-flet ((fallback-bol - () - (back-to-indentation) - (if (eobp) - (line-beginning-position 0) - (point))) - (fallback-eol - (beg) - (progn - (end-of-line) - (skip-chars-backward " \t\f\n" beg) - (if (eq (point) beg) - (line-beginning-position 2) - (point))))) - (if (and col (cl-plusp col)) - (let* ((beg (progn (forward-char (1- col)) - (point))) - (sexp-end (or (ignore-errors (end-of-thing 'sexp)) - (save-match-data - (ignore-errors (end-of-thing 'symbol))))) - (end (or (and sexp-end - (not (= sexp-end beg)) - sexp-end) - (and (< (goto-char (1+ beg)) (point-max)) - (point))))) - (if end - (cons beg end) - (cons (setq beg (fallback-bol)) - (fallback-eol beg)))) - (let* ((beg (fallback-bol)) - (end (fallback-eol beg))) - (cons beg end))))))) + (save-match-data + (goto-char (point-min)) + (forward-line (1- line)) + (cl-flet ((fallback-bol + () + (back-to-indentation) + (if (eobp) + (line-beginning-position 0) + (point))) + (fallback-eol + (beg) + (progn + (end-of-line) + (skip-chars-backward " \t\f\n" beg) + (if (eq (point) beg) + (line-beginning-position 2) + (point))))) + (if (and col (cl-plusp col)) + (let* ((beg (progn (forward-char (1- col)) + (point))) + (sexp-end (or (ignore-errors (end-of-thing 'sexp)) + (ignore-errors (end-of-thing 'symbol)))) + (end (or (and sexp-end + (not (= sexp-end beg)) + sexp-end) + (and (< (goto-char (1+ beg)) (point-max)) + (point))))) + (if end + (cons beg end) + (cons (setq beg (fallback-bol)) + (fallback-eol beg)))) + (let* ((beg (fallback-bol)) + (end (fallback-eol beg))) + (cons beg end)))))))) (error (flymake-log :warning "Invalid region line=%s col=%s" line col) nil))) From 0ad1c0d51cd3e1b02deedee9b05647fcd0734076 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 18 Dec 2020 13:33:31 +0100 Subject: [PATCH 122/148] * lisp/net/tramp.el (tramp-handle-make-process): Handle shell commands. --- lisp/net/tramp.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a4865ec4f22..30818fe7e64 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3790,6 +3790,15 @@ It does not support `:stderr'." (unless (or (null stderr) (bufferp stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) + ;; Quote shell command. + (when (and (= (length command) 3) + (stringp (nth 0 command)) + (string-match-p "sh$" (nth 0 command)) + (stringp (nth 1 command)) + (string-equal "-c" (nth 1 command)) + (stringp (nth 2 command))) + (setcar (cddr command) (tramp-shell-quote-argument (nth 2 command)))) + (let* ((buffer (if buffer (get-buffer-create buffer) From 46394dff7f01e7fe4af06a6c344e151af5c3eef4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 18 Dec 2020 14:35:09 +0100 Subject: [PATCH 123/148] Follow good regexp practice These were found by relint 1.19. * lisp/help-fns.el (help-fns--first-release): Use string-end instead of line-end when matching a file name. * lisp/org/ob-core.el (org-babel--string-to-number): Put hyphen last in alternative. * lisp/org/org-agenda.el (org-agenda-filter): Escape '+' correctly. --- lisp/help-fns.el | 2 +- lisp/org/ob-core.el | 2 +- lisp/org/org-agenda.el | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 043c79f3900..20fe382cb09 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -653,7 +653,7 @@ FILE is the file where FUNCTION was probably defined." ;; of the *packages* in which the function is defined. (let* ((name (symbol-name symbol)) (re (concat "\\_<" (regexp-quote name) "\\_>")) - (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)")) + (news (directory-files data-directory t "\\`NEWS\\(\\'\\|\\.\\)")) (place nil) (first nil)) (with-temp-buffer diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 7300f239eef..ede35e154a3 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2995,7 +2995,7 @@ situations in which is it not appropriate." "If STRING represents a number return its value. Otherwise return nil." (unless (or (string-match-p "\\s-" (org-trim string)) - (not (string-match-p "^[0-9-e.+ ]+$" string))) + (not (string-match-p "^[0-9e.+ -]+$" string))) (let ((interned-string (ignore-errors (read string)))) (when (numberp interned-string) interned-string)))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 83f30bf96af..5a2ba027f97 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -7734,9 +7734,9 @@ the variable `org-agenda-auto-exclude-function'." (negate (equal strip-or-accumulate '(4))) (cf (mapconcat #'identity org-agenda-category-filter "")) (tf (mapconcat #'identity org-agenda-tag-filter "")) - (rpl-fn (lambda (c) (replace-regexp-in-string "^\+" "" (or (car c) "")))) - (ef (replace-regexp-in-string "^\+" "" (or (car org-agenda-effort-filter) ""))) - (rf (replace-regexp-in-string "^\+" "" (or (car org-agenda-regexp-filter) ""))) + (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) + (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) ""))) + (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) ""))) (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) (f-string (completing-read (concat From eaea03546a291e27c5794599040b8bb464118d9f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Dec 2020 09:16:29 -0500 Subject: [PATCH 124/148] * lisp/progmodes/which-func.el (which-func-update): Bind `non-essential` --- lisp/progmodes/which-func.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index a524bbaa223..562a357a8cb 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -186,7 +186,7 @@ and you want to simplify them for the mode line "Non-nil means display current function name in mode line. This makes a difference only if `which-function-mode' is non-nil.") -(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t) +(add-hook 'after-change-major-mode-hook #'which-func-ff-hook t) (defun which-func-try-to-enable () (unless (or (not which-function-mode) @@ -216,7 +216,8 @@ It creates the Imenu index for the buffer, if necessary." (defun which-func-update () ;; "Update the Which-Function mode display for all windows." ;; (walk-windows 'which-func-update-1 nil 'visible)) - (which-func-update-1 (selected-window))) + (let ((non-essential t)) + (which-func-update-1 (selected-window)))) (defun which-func-update-1 (window) "Update the Which Function mode display for window WINDOW." @@ -356,7 +357,7 @@ This function is meant to be called from `ediff-select-hook'." (when ediff-window-C (which-func-update-1 ediff-window-C)))) -(add-hook 'ediff-select-hook 'which-func-update-ediff-windows) +(add-hook 'ediff-select-hook #'which-func-update-ediff-windows) (provide 'which-func) From 48b9c47805fc304441017f6ee4c114212cdb0496 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 18 Dec 2020 09:38:29 -0500 Subject: [PATCH 125/148] Minor fixes in authors.el and in tarball-making instructions * admin/authors.el (authors): Make the error message more helpful. (authors-ignored-files, authors-renamed-files-alist): Update. --- admin/authors.el | 18 ++++++++++++++---- admin/make-tarball.txt | 25 ++++++++++++++++++++----- 2 files changed, 34 insertions(+), 9 deletions(-) diff --git a/admin/authors.el b/admin/authors.el index a418efea44f..f06b2129bfe 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -467,7 +467,12 @@ Changes to files matching one of the regexps in this list are not listed.") "notes/font-backend" ;; ada-mode has been deleted, now in GNU ELPA "ada-mode.texi" + "doc/misc/ada-mode.texi" + "lisp/progmodes/ada-mode.el" + "lisp/progmodes/ada-prj.el" + "lisp/progmodes/ada-xref.el" "GNUS-NEWS" + "etc/GNUS-NEWS" "doc/misc/gnus-news.el" "src/fingerprint-dummy.c" "src/fingerprint.h" @@ -875,6 +880,7 @@ Changes to files in this list are not listed.") "lisp/obsolete/spell.el" "lisp/obsolete/swedish.el" "lisp/obsolete/sym-comp.el" + "obsolete/sym-comp.el" "library-of-babel.org" "flymake-elisp.el" "flymake-ui.el" @@ -994,7 +1000,8 @@ in the repository.") ("nxml/test.invalid.xml" . "test-invalid.xml") ("nxml/test.valid.xml" . "test-valid.xml") ("automated/Makefile.in" . "test/Makefile.in") - ("test/rmailmm.el" . "rmailmm.el") + ("test/rmailmm.el" . "test/manual/rmailmm.el") + ("rmailmm.el" . "test/manual/rmailmm.el") ;; The one in lisp is eshell/eshell.el. ("eshell.el" . "eshell-tests.el") ("automated/eshell.el" . "eshell-tests.el") @@ -1118,8 +1125,11 @@ in the repository.") ("lisp/net/starttls.el" . "lisp/obsolete/starttls.el") ("url-ns.el" . "lisp/obsolete/url-ns.el") ("gnus-news.texi" . "doc/misc/gnus.texi") - ("lisp/multifile.el". "lisp/fileloop.el") - ("lisp/emacs-lisp/thread.el". "lisp/thread.el") + ("lisp/multifile.el" . "lisp/fileloop.el") + ("lisp/emacs-lisp/thread.el" . "lisp/thread.el") + ("lisp/emacs-lisp/cl.el" . "lisp/emacs-lisp/cl-lib.el") + ("lisp/progmodes/mantemp.el" . "lisp/obsolete/mantemp.el") + ("sysdep.c" . "src/sysdep.c") ) "Alist of files which have been renamed during their lifetime. Elements are (OLDNAME . NEWNAME).") @@ -1593,7 +1603,7 @@ and a buffer *Authors Errors* containing references to unknown files." ;; the versioned ChangeLog.N rather than the unversioned ChangeLog. (zerop (call-process "make" nil nil nil "-C" root "change-history-nocommit")) - (error "Problem updating ChangeLog")) + (error "Problem updating ChangeLog, try \"C-u M-x authors RET\"")) (let ((logs (process-lines find-program root "-name" "ChangeLog*")) (table (make-hash-table :test 'equal)) (buffer-name "*Authors*") diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 2c81a49e096..5125086e881 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -33,17 +33,32 @@ General steps (for each step, check for possible errors): or some form of "git clean -x". It's probably simpler and safer to make a new working directory exclusively for the release branch. + Make sure the tree is built, or at least configured. That's + because some of the commands below run Make, so they need + Makefiles to be present. + 2. Regenerate the etc/AUTHORS file: M-: (require 'authors) RET M-x authors RET (This first updates the current versioned ChangeLog.N) - If there is an "*Authors Errors*" buffer, address the issues. - If there was a ChangeLog typo, fix the relevant entry. - If a file was deleted or renamed, consider adding an appropriate - entry to authors-ignored-files, authors-valid-file-names, or - authors-renamed-files-alist. + If this says "Problem updating ChangeLog", find the reason for the + failure of the command it runs, viz.: + + make -C ROOT change-history-nocommit + + (where ROOT is the top-level directory where you run this). It + could be because there are uncommitted changes in ChangeLog.N, for + example. One possible way forward is to invoke "C-u M-x authors", + which will skip updating the versioned ChangeLog.N file. + + After "M-x authors" finishes, if there is an "*Authors Errors*" + buffer, address the issues. If there was a ChangeLog typo, fix + the relevant entry. If a file was deleted or renamed, consider + adding an appropriate entry to variables authors-ignored-files, + authors-valid-file-names, or authors-renamed-files-alist in + authors.el. If necessary, repeat 'C-u M-x authors' after making those changes. Save the "*Authors*" buffer as etc/AUTHORS. From eeade2b64767bfce9118eae36c25363a7fb6ea76 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Dec 2020 10:02:15 -0500 Subject: [PATCH 126/148] * lisp/emacs-lisp/package.el: Byte compile the quickstart file Earlier tests had found problems when byte-compiling the file, but later investigations indicated the problem was not directly related. The performance difference is appreciable. (package-quickstart-refresh): Byte compile the file. (package-activate-all): Load byte-compiled version if available. (package--quickstart-maybe-refresh): Delete the byte-compiled file as well. --- lisp/emacs-lisp/package.el | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b7c48dfd3f5..f6ad6d2ebc7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1615,18 +1615,22 @@ that code in the early init-file." "Activate all installed packages. The variable `package-load-list' controls which packages to load." (setq package--activated t) - (if (file-readable-p package-quickstart-file) - ;; Skip load-source-file-function which would slow us down by a factor - ;; 2 (this assumes we were careful to save this file so it doesn't need - ;; any decoding). - (let ((load-source-file-function nil)) - (load package-quickstart-file nil 'nomessage)) - (dolist (elt (package--alist)) - (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))))))) + (let* ((elc (concat package-quickstart-file "c")) + (qs (if (file-readable-p elc) elc + (if (file-readable-p package-quickstart-file) + package-quickstart-file)))) + (if qs + ;; Skip load-source-file-function which would slow us down by a factor + ;; 2 when loading the .el file (this assumes we were careful to + ;; save this file so it doesn't need any decoding). + (let ((load-source-file-function nil)) + (load qs nil 'nomessage)) + (dolist (elt (package--alist)) + (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)))))))) ;;;; Populating `package-archive-contents' from archives ;; This subsection populates the variables listed above from the @@ -4041,6 +4045,7 @@ activations need to be changed, such as when `package-load-list' is modified." ;; FIXME: Delay refresh in case we're installing/deleting ;; several packages! (package-quickstart-refresh) + (delete-file (concat package-quickstart-file "c")) (delete-file package-quickstart-file))) (defun package-quickstart-refresh () @@ -4098,7 +4103,8 @@ activations need to be changed, such as when `package-load-list' is modified." ;;\sno-byte-compile: t ;; no-update-autoloads: t ;; End: -")))) +")) + (byte-compile-file package-quickstart-file))) (defun package--imenu-prev-index-position-function () "Move point to previous line in package-menu buffer. From 37eba74d609c74bcf9ac3c481a29377913783ac4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 18 Dec 2020 10:13:53 -0500 Subject: [PATCH 127/148] Update files for the 27.1.90 pretest * README: * configure.ac: * nt/README.W32: * msdos/sed2v2.inp: Bump Emacs version to 27.1.90. * lisp/ldefs-boot.el: Update from loaddefs.el --- ChangeLog.3 | 1642 +++++++++++++++++++++++++++++++++++++++++++- README | 2 +- configure.ac | 2 +- etc/AUTHORS | 368 +++++----- lisp/ldefs-boot.el | 720 +++---------------- msdos/sed2v2.inp | 2 +- nt/README.W32 | 2 +- 7 files changed, 1924 insertions(+), 814 deletions(-) diff --git a/ChangeLog.3 b/ChangeLog.3 index 1a530118995..0ce1e18b59b 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,1643 @@ +2020-12-18 Eli Zaretskii + + * README: + * configure.ac: + * nt/README.W32: + * msdos/sed2v2.inp: Bump Emacs version to 27.1.90. + +2020-12-18 Eli Zaretskii + + Minor fixes in authors.el and in tarball-making instructions + + * admin/authors.el (authors): Make the error message more helpful. + (authors-ignored-files, authors-renamed-files-alist): Update. + +2020-12-16 Eli Zaretskii + + Improve documentation of 'query-replace' + + * doc/emacs/search.texi (Query Replace): Add 'E' to the list of + characters one can type at 'query-replace' prompt. (Bug#45273) + +2020-12-16 Bastien Guerry + + Update to Org 9.4.3 + + Fix #45259 + +2020-12-14 Alan Third + + Fix error with fn key in NS port (bug#44533) + + * src/nsterm.m ([EmacsView keyDown:]): Move the correction for fn key + handling to before the modifiers are calculated. + + (cherry picked from commit 7970610d48701a949ce443c94c71eac47d044197) + +2020-12-14 Eli Zaretskii + + Fix point location when completing in gdb-mi.el + + * lisp/progmodes/gdb-mi.el (def-gdb-auto-update-handler): Don't + force window-start position, so that redisplay doesn't move point + when popping completion window below the GUD one. (Bug#45052) + +2020-12-13 Bastien Guerry + + Update to Org 9.4.2 + + Mostly fixing compiler warnings. + +2020-12-13 Bastien Guerry + + Update to Org 9.4.1 + +2020-12-12 Alan Third + + Fix crash in ns_mouse_position (bug#44313) + + * src/nsterm.m (ns_destroy_window): Close the window before freeing + the frame resources so we don't end up accessing the frame struct + after it's been freed. + + (cherry picked from commit 18a7267c32a909bb26bd93d24543155aeb10e042) + +2020-12-12 Alan Third + + Fix crash when using XRender and restoring image from X (bug#44930) + + * src/dispextern.h (struct image): Add original dimension elements. + * src/image.c (image_set_transform): Store the original dimensions. + (image_get_x_image): If we're using transforms use the original + dimensions with XGetImage. + +2020-12-11 Tassilo Horn + + Bind k to image-kill-buffer in doc-view-mode-map. + + * lisp/doc-view.el (doc-view-mode-map): Bind k to image-kill-buffer. + The binding k -> doc-view-kill-proc-and-buffer has been removed in + 2015 and the function been made an obsolete function alias to + image-kill-buffer (bug#45157). + +2020-12-09 Serge Tupchii (tiny change) + + Fix crash (segfault) in etags on generating tags for Erlang files + + * lib-src/etags.c: Set allocated and lastlen to zero, after + freeing last ptr in Erlang_functions to prevent dereferencing NULL + pointer (bug#45122). + + + (cherry picked from commit 2d8f0364fcd1d5dad2b82dd3a9af870b03854547) + +2020-12-09 Stefan Kangas + + Update publicsuffix.txt from upstream + + * etc/publicsuffix.txt: Update from + https://publicsuffix.org/list/public_suffix_list.dat + dated 2020-11-30 21:57:25 UTC. + +2020-12-06 Juri Linkov + + * lisp/vc/vc.el: Update args of backend API calls in the header comments + + https://lists.gnu.org/archive/html/emacs-devel/2020-12/msg00283.html + +2020-12-06 Juri Linkov + + Backport Handle read-char-from-minibuffer and y-or-n-p from pre-command-hook + + * lisp/subr.el (read-char-from-minibuffer-insert-char) + (read-char-from-minibuffer-insert-other, y-or-n-p-insert-y) + (y-or-n-p-insert-n, y-or-n-p-insert-other): + Check for 'minibufferp' before executing the body. + (read-char-from-minibuffer, y-or-n-p): Let-bind this-command + before calling read-from-minibuffer. (Bug#45029) + +2020-12-06 Eli Zaretskii + + Improve documentation of streams in batch mode + + * doc/lispref/os.texi (Batch Mode): + * doc/lispref/streams.texi (Input Streams, Output Streams): Better + documentation of I/O streams in batch mode, with more + cross-references. + +2020-12-06 Eli Zaretskii + + Support ks_c_5601-1987 encoding + + * lisp/language/korean.el (ks_c_5601-1987): Define as an alias for + 'korean-iso-8bit. (It is sometimes used in email messages.) + +2020-12-06 YAMAMOTO Mitsuharu + + Fix Xaw widget text disappearing when built with cairo (bug#43418) + + * lwlib/lwlib-utils.c (crxft_font_open_name): Use FcFontMatch to + get a pattern to pass to cairo_ft_font_face_create_for_pattern. + +2020-12-05 Eli Zaretskii + + Improve documentation of 'ps-print-color-p' + + * doc/emacs/misc.texi (PostScript Variables): Improve and clarify + the description of 'ps-print-color-p'. (Bug#44962) + +2020-11-30 Dmitry Gutov + + Reset xref-show-xrefs-function temporarily + + * lisp/dired-aux.el (dired-do-find-regexp-and-replace): + Make sure xref-show-xrefs-function has the necessary value (bug#44905). + +2020-11-30 Eli Zaretskii + + Don't show in 'view-lossage' responses to xterm feature queries + + * lisp/term/xterm.el (xterm--read-event-for-query): Prevent + recording the characters read as the xterm response to a query, + so as not to show them in 'view-lossage'. (Bug#44908) + +2020-11-30 Michael Albinus + + Adapt Tramp versions. Do not merge + + * doc/misc/tramp.texi (Obtaining @value{tramp}) + (Remote shell setup, Remote processes, Archive file names): + * doc/misc/trampver.texi: + * lisp/net/tramp.el: + * lisp/net/trampver.el (tramp-version) + (customize-package-emacs-version-alist): Adapt Tramp versions. + +2020-11-29 Akira Kyle + + Return the correct suffix in eww-make-unique-file-name + + * lisp/net/eww.el (eww-make-unique-file-name): Return the correct + suffix (bug#44936). + +2020-11-28 Karl Fogel + + Save bookmarks by using `write-file' (bug#12507) + + Go back to using `write-file' to save bookmarks, instead of using + `write-region'. This means numbered backups of the bookmark file may + get made again, depending on the value of `bookmark-version-control'. + + Thanks especially to Drew Adams and Eli Zaretskii for their + persistence in tracking down information relevant to this change. + +2020-11-28 Eli Zaretskii + + Fix filing messages when 'rmail-output-reset-deleted-flag' is non-nil + + * lisp/mail/rmailout.el (rmail-output): Fix off-by-one error in + deciding when to advance to the next message under non-nil + 'rmail-output-reset-deleted-flag'. (Bug#44839) + +2020-11-28 Michael Albinus + + Make file copying in tramp-gvfs more robust + + * test/lisp/net/tramp-tests.el (tramp-test11-copy-file) + (tramp-test12-rename-file): Do not skip for tramp-gvfs.el. + + * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): + Add sanity checks. + +2020-11-28 Eli Zaretskii + + Revert "Fix incorrect handling of module runtime and environment pointers." + + This reverts commit cdc632fbe6e149318147a98cccf1b7af191f2ce8. + Those changes are too significant and non-trivial to be + suitable for a release branch at this time. + +2020-11-27 Philipp Stephani + + Fix incorrect handling of module runtime and environment pointers. + + We used to store module runtime and environment pointers in the static + lists Vmodule_runtimes and Vmodule_environments. However, this is + incorrect because these objects have to be kept per-thread. With this + naive approach, interleaving module function calls in separate threads + leads to environments being removed in the wrong order, which in turn + can cause local module values to be incorrectly garbage-collected. + + Instead, turn Vmodule_runtimes and Vmodule_environments into + hashtables keyed by the thread objects. The fix is relatively + localized and should therefore be safe enough for the release branch. + + Module assertions now have to walk the pointer list for the current + thread, which is more correct since they now only find environments + for the current thread. + + Also add a unit test that exemplifies the problem. It interleaves two + module calls in two threads so that the first call ends while the + second one is still active. Without this change, this test triggers + an assertion failure. + + * src/emacs-module.c (Fmodule_load, initialize_environment) + (finalize_environment, finalize_runtime_unwind): Store runtime and + environment pointers in per-thread lists. + (syms_of_module): Initialize runtimes and environments hashtables. + (module_assert_runtime, module_assert_env, value_to_lisp): Consider + only objects for the current thread. + (module_gc_hash_table_size, module_hash_push, module_hash_pop): New + generic hashtable helper functions. + (module_objects, module_push_pointer, module_pop_pointer): New helper + functions to main thread-specific lists of runtime and environment + pointers. + (mark_modules): Mark all environments in all threads. + + * test/data/emacs-module/mod-test.c (Fmod_test_funcall): New test + function. + (emacs_module_init): Bind it. + + * test/src/emacs-module-tests.el (emacs-module-tests--variable): New + helper type to guard access to state in a thread-safe way. + (emacs-module-tests--wait-for-variable) + (emacs-module-tests--change-variable): New helper functions. + (emacs-module-tests/interleaved-threads): New unit test. + +2020-11-26 Alan Mackenzie + + CC Mode: Fix error in cache handling. This fixes bug #43481 + + * lisp/progmodes/cc-engine.el (c-full-pp-to-literal): Handle correctly END + being before HERE by using parse-partial-sexp to get the end of the literal + containing HERE. + +2020-11-25 Martin Rudalics + + Revert extra focus redirection in do_switch_frame (Bug#24803) + + * src/frame.c (do_switch_frame): Do not also redirect frame + focus when FRAME has its minibuffer window on the selected + frame which was intended to fix Bug#24500. It may cause + Bug#24803 and lead to a nasty state where no active cursor is + shown on any frame, see + https://lists.gnu.org/archive/html/emacs-devel/2020-11/msg01137.html. + +2020-11-25 Michael Albinus + + Minor cleanup of tramp-tests.el on MS Windows + + * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process): + Do not test remote pty on MS Windows. + +2020-11-24 Basil L. Contovounesios + + Fix handling of defcustom :local tag + + For discussion, see the following emacs-devel thread: + https://lists.gnu.org/r/emacs-devel/2020-11/msg00734.html + + * lisp/custom.el (custom-declare-variable): Delay call to + make-variable-buffer-local until after user option has been + initialized with a value. Otherwise the user option may be + initialized to nil. + * test/lisp/custom-tests.el (custom--test-local-option) + (custom--test-permanent-option): New :local user options. + (custom-test-local-option): New test for defcustom :local keyword. + +2020-11-24 Alan Mackenzie + + CC Mode. Fix an off by one error. Fixes bug #41809 + + * lisp/progmodes/cc-engine.el (c-full-pp-to-literal): Change > to >= (twice). + +2020-11-24 Eli Zaretskii + + Fix display artifacts when 'display' properties cover newlines + + * src/xdisp.c (pos_visible_p): Set glyph_row of scratch iterators + to NULL, to avoid producing glyphs while we figure out the layout. + (Bug#44826) + +2020-11-23 Stefan Kangas + + Sync latest SKK-JISYO.L + + * leim/SKK-DIC/SKK-JISYO.L: Sync to current upstream version. + + (cherry picked from commit 6a5f9700846551a7f3795e257356dbab865116f4) + +2020-11-23 Stefan Kangas + + Update publicsuffix.txt from upstream + + * etc/publicsuffix.txt: Update from + https://publicsuffix.org/list/public_suffix_list.dat + dated 2020-10-09 08:23:34 UTC. + + (cherry picked from commit 5b13afab0a903ead8363482529019d4fb80ec4b4) + +2020-11-21 Michael Albinus + + Fix Bug#44481 + + * lisp/net/tramp.el (tramp-system-name): New defconst. + (tramp-default-host, tramp-restricted-shell-hosts-alist) + (tramp-local-host-regexp): + * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Use it. (Bug#44481) + +2020-11-21 Lars Ingebrigtsen + + Minor Edebug manual keystroke clarifications + + * doc/lispref/edebug.texi (Edebug Misc): Also mention the `a' + binding to abort (bug#44697). Also fix `d' function reference, and + add `P' reference. + + (cherry picked from commit b613f25f97abf756101eaa2af90689a19c0b3350) + +2020-11-21 Eli Zaretskii + + Make ignoring modifiers on IME input optional + + By default, ignore modifier keys on IME input, but add + a variable to get back old behavior. + * src/w32fns.c (syms_of_w32fns): New variable + w32-ignore-modifiers-on-IME-input. + (w32_wnd_proc): Use it to ignore modifier keys when IME input is + used. (Bug#44641) + + * etc/NEWS: Announce the change and the new variable. + +2020-11-21 Masahiro Nakamura + + Ignore modifiers when processing WM_IME_CHAR messages + + * src/w32fns.c (w32_wnd_proc): Ignore modifiers when processing + WM_IME_CHAR messages. + +2020-11-19 Eli Zaretskii + + Improve documentation of 'font-spec' + + * doc/lispref/display.texi (Low-Level Font): + * src/font.c (Ffont_spec): Document 'font-spec' keys that are + supported, but were undocumented. + +2020-11-18 Lars Ingebrigtsen + + Further doc fixes for dotimes about RESULT + + * lisp/subr.el (dotimes): Be even more explicit about RESULT + (bug#16206). + + (cherry picked from commit 5b0d8d0f288fd505ca90bd30df709a5e7ab540d6) + +2020-11-15 Eli Zaretskii + + Reformat argument commentary in etags.c + + * lib-src/etags.c (pfnote, consider_token, C_entries): Resurrect + original format of comments to function arguments. + +2020-11-15 Alan Mackenzie + + Make the invocation of combine-change-calls in comment-region valid + + This fixes bug #44581. The problem was that whitespace outside of the (BEG + END) region was being deleted, and this made the invocation of + combine-change-calls with (BEG END) invalid. + + * lisp/newcomment.el (comment-region-default): Amend the second argument to + combine-change-calls. + +2020-11-15 Alan Mackenzie + + * lisp/progmodes/cc-langs.el (c-<>-notable-chars-re): Fix wrong '-' in regexp + +2020-11-14 Eli Zaretskii + + Update the various INSTALL files + + * nt/INSTALL.W64: + * nt/INSTALL: + * INSTALL: Update the installation information, in particular the + fact that HarfBuzz is now preferred as the shaping library. + +2020-11-14 Eli Zaretskii + + Don't leave lock files after 'replace-buffer-contents' + + * src/editfns.c (Freplace_buffer_contents): Unlock the buffer's + file if no changes have been made. (Bug#44303) + + (cherry picked from commit a5867ddfbd721568005175bf6c725f7834b21ea4) + +2020-11-14 Eli Zaretskii + + Fix input method translation near read-only text + + * lisp/international/quail.el (quail-input-method): Don't disable + input method when the character after point has the read-only + property. Suggested by Evgeny Zajcev + (Bug#44466) + + * doc/emacs/mule.texi (Input Methods): Document that input methods + are inhibited in read-only text. + +2020-11-14 Eli Zaretskii + + Fix display of truncated R2L lines on TTY frames + + * src/xdisp.c (extend_face_to_end_of_line): Use a while-loop, not + a do-while loop, to avoid appending an extra glyph at the end of a + line that is one character shorter than the window-width. This is + needed to fix display of reversed glyph rows that are almost as + wide as the window, because append_space_for_newline already added + one space glyph. + +2020-11-14 Eli Zaretskii + + Avoid crashes when a reversed glyph row starts with a composition + + * src/dispnew.c (build_frame_matrix_from_leaf_window): Add an + assertion to prevent us from overwriting non-char glyphs with the + vertical border glyph. + * src/xdisp.c (extend_face_to_end_of_line): Account for one glyph + possibly inserted by append_space_for_newline. (Bug#44506) + Remove a kludgey correction for an off-by-one error in column + counting, which is no longer needed. + +2020-11-13 Eli Zaretskii + + Update information about refcards + + * admin/release-process (refcards): + * admin/make-tarball.txt (refcards): Update information about + generating refcards and required TeX/LaTeX packages. + +2020-11-11 Eli Zaretskii + + Avoid crashes in the daemon due to user interaction + + * src/minibuf.c (read_minibuf): Avoid crashes in the daemon if the + init file invokes some kind of minibuffer interaction, by not + updating the selected frame if it's the initial frame. + (Bug#44583) + +2020-11-11 Michael Albinus + + Some minor changes to Tramp, do not merge with master + + * lisp/net/tramp.el (tramp-handle-directory-files) + (tramp-handle-directory-files-and-attributes): + * lisp/net/tramp-adb.el + (tramp-adb-handle-directory-files-and-attributes): + * lisp/net/tramp-rclone.el (tramp-rclone-handle-directory-files): + * lisp/net/tramp-sh.el (tramp-sh-handle-directory-files-and-attributes): + * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Add _COUNT. + Make the functions forward compatible. + + * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): + Increase `max-specpdl-size' temporarily. + + * test/lisp/net/tramp-tests.el (tramp--test-share-p): New defun. + (tramp-test05-expand-file-name-relative): Use it. + +2020-11-10 Lars Ingebrigtsen + + Add more doc-view requirements + + * lisp/doc-view.el: Add more requirements. + +2020-11-09 Philipp Stephani + + Fix undefined behavior when fetching glyphs from the display vector. + + You can trigger this rather obscure bug by enabling selective display + if the second glyph in its display vector has an invalid face. For + example, evaluate + + (set-display-table-slot standard-display-table + 'selective-display [?A (?B . invalid)]) + + and then enable selective display. + + * src/xdisp.c (next_element_from_display_vector): Check whether next + glyph code is valid before accessing it. + +2020-11-09 Mattias Engdegård + + Fix pcase rx form snag with '?' and '??' (bug#44532) + + This is a regression from Emacs 26. + Reported by Phillip Stephani. + + * lisp/emacs-lisp/rx.el (rx--pcase-transform): Process ? and ?? correctly. + * test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add test case. + + (cherry picked from commit 575b0681d926463960fc00d1e33decaa71d5c956) + +2020-11-09 Lars Ingebrigtsen + + Update the doc-view header line + +2020-11-09 Eli Zaretskii + + Avoid breaking Arabic shaping in 'window-text-pixel-size' + + * src/xdisp.c (CHAR_COMPOSED_P): If the bidi_p flag is not set, + pass -1 to composition_reseat_it, so that the shaping engine will + figure out the directionality of the text. This is important, + e.g., when using move_it_* functions in some context that is not + redisplay, such as 'window-text-pixel-size'. (Bug#44521) + +2020-11-09 Lars Ingebrigtsen + + doc-view.el comment clarification + + * lisp/doc-view.el: Make the commentary mention that it's not + limited to a narrow range of file formats (bug#44504). + +2020-11-09 Daniel Martín + + Update erc documentation about C-c C-b + + * doc/misc/erc.texi (Keystroke Summary): C-c C-b runs + erc-switch-to-buffer, which is implemented in terms of + read-buffer (bug#44498). + +2020-11-07 Kazuhiro Ito (tiny change) + + Fix 'uudecode-decode-region-internal' in multibyte buffers + + * lisp/mail/uudecode.el (uudecode-decode-region-internal): Fix + inserting the decoded string into a multibyte buffer. Optimize by + working with characters, not strings. (Bug#44411) + +2020-11-07 Eli Zaretskii + + Fix 'send-string-to-terminal' writing very long strings + + * src/dispnew.c (Fsend_string_to_terminal): Prevent partial writes + by blocking SIGIO while 'fwrite' runs. (Bug#44320) + +2020-11-07 Eli Zaretskii + + * lisp/subr.el (read-char-from-minibuffer): Doc fix. (Bug#44451) + +2020-11-07 Earl Hyatt + + Fix documentation of 'windmove-swap-states-default-keybindings' + + * doc/emacs/windows.texi (Window Convenience): Fix description of + 'windmove-swap-states-default-keybindings' and related index + entry. (Bug#44441) + +2020-11-07 Martin Rudalics + + Split windows evenly when 'min-margins' parameter was set (Bug#44483) + + * lisp/window.el (split-window): Make new window inherit any + 'min-margins' parameter from WINDOW so that horizontal splits + reliably produce windows of same width (Bug#44483). + +2020-11-07 Pip Cet + + Handle Cairo errors in ftcrfont_open + + * src/ftcrfont.c (ftcrfont_open): Handle Cairo errors (bug#41627). + + (cherry picked from commit 954a4decfcc8e41084789516773b22d0adc11d91) + +2020-11-06 Stefan Kangas + + Backport: Fix exiting the finder-commentary buffer + + Do not merge to master. + + * lisp/finder.el (finder-exit): Fix exiting the finder-commentary + buffer. (Bug#44384) + (finder-buffer): New defconst. + (finder-list-keywords): Use above new defconst. + +2020-11-05 Eli Zaretskii + + * src/w32fns.c (Fw32_register_hot_key): Doc fix. (Bug#44456) + +2020-11-04 Eli Zaretskii + + Prevent redisplay from moving point behind user's back + + * src/bidi.c (bidi_at_paragraph_end, bidi_find_paragraph_start): + Bind inhibit-quit to a non-nil value around calls to + fast_looking_at, to prevent breaking out of redisplay_window, + which temporarily moves point in buffers shown in non-selected + windows. (Bug#44448) + +2020-11-02 Mauro Aranda + + Document that the :match function for a widget takes an external value + + * doc/misc/widget.texi (Basic Types): Document what an external value + is. Document that a :match function expects the value to be in the + external format. (Bug#8717) + +2020-11-02 Stephen Berman + + Don't render XML declaration of an HTML document (bug#44348) + + * lisp/net/eww.el (eww--preprocess-html): Prevent converting the + left angle bracket in the sequence " (tiny change) + + Recover the contents of the schemas.xml file + + * etc/schema/schemas.xml: Recover the file, which was apparently + (mostly) removed by mistake by commit 165f738382 (bug#42851). + +2020-11-01 Stefan Kangas + + Improve indexing of check-declare + + * doc/lispref/functions.texi (Declaring Functions): Improve indexing. + +2020-10-31 Eli Zaretskii + + * doc/lispref/commands.texi (Key Sequence Input): Fix indexing. + + (cherry picked from commit 41c4f337c8f798d4700dcd13b73ad4ccdb3257eb) + +2020-10-31 Jared Finder + + Updating docs with all special window prefix keys. + + * doc/lispref/commands.texi (Key Sequence Input): Add documentation for + missing special window areas. Explicitly call out window or frame. + + (cherry picked from commit a105db13e11fd15cc72804bf33672122d1c3f2e1) + +2020-10-30 Glenn Morris + + Improve reproducibility of generated -pkg.el files + + * lisp/emacs-lisp/package.el (package-generate-description-file): + Don't include the full name of the source file in the header, + since that varies non-reproducibly according to the build directory. + https://bugs.debian.org/972861 + Note that elpa.gnu.org's admin/archive-contents.el does this by hand + and already only includes the nondirectory part. + +2020-10-29 Noah Friedman + + Make sure pixel sizes are zero when setting window size for ptys. + + * sysdep.c (set_window_size): Initialize data to zero to avoid + passing any garbage from the stack to ioctl. + +2020-10-29 Ken Brown + + Fix failure of 'emacs --daemon' on Cygwin + + * src/emacs.c (DAEMON_MUST_EXEC): Define unconditionally on + Cygwin, not just if HAVE_NTGUI is defined. This fixes the failure + of 'emacs --daemon' to start on the non-w32 Cygwin builds. + (Bug#44285) + +2020-10-28 Alan Mackenzie + + CC Mode: Only recognize foo (*bar) as a function pointer when followed by ( + + * lisp/progmodes/cc-engine.el (c-forward-over-decl-or-cast-1): (after CASE 2) + test variables got-suffix-after-parens and at-decl-end before invoking + c-fdoc-shift-type-backward. + +2020-10-27 Clemens Radermacher + + Fix NEWS entry for fix of Bug#44080 + +2020-10-27 Eli Zaretskii + + * src/buffer.c (syms_of_buffer) : Improve doc string. + +2020-10-27 Clemens Radermacher + + Don't skip empty lines when fitting mini frame to buffer (Bug#44080) + + * lisp/window.el (fit-mini-frame-to-buffer, + window--resize-mini-frame, fit-frame-to-buffer, + fit-frame-to-buffer-1): By default, fit a mini frame without skipping its + buffer's leading or trailing empty lines. + * src/frame.c (resize-mini-frames): Update doc-string. + * lisp/cus-start.el (resize-mini-frames): Update for customize. + * doc/lispref/minibuf.texi (resize-mini-frames): Update description. + +2020-10-26 Eli Zaretskii + + Improve documentation of display-fill-column-indicator + + * lisp/display-fill-column-indicator.el + (display-fill-column-indicator-mode): Mention the globalized + version in the doc string. + + * doc/emacs/display.texi (Displaying Boundaries): Improve and + clarify the documentation of display-fill-column-indicator. + Suggest using the minor mode as the primary means for turning the + feature on. + + * src/xdisp.c (syms_of_xdisp) + : Doc fix. (Bug#44226) + +2020-10-25 Michael Albinus + + * INSTALL: Mention efaq.texi for installation of intlfonts. + +2020-10-24 Paul Eggert (tiny change) + Qiantan Hong + + Use WebKit sandboxing + + * src/xwidget.c (Fmake_xwidget): Enable sandboxing if WebKit 2.26 + or later. Do this early, as required for sandboxing (Bug#43071). + +2020-10-24 Michael Albinus + + Fix tramp-sh-handle-make-process; don't merge with master + + * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Accept nil + COMMAND. (Bug#44151) + + * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process): + Extend test. + +2020-10-23 Michael Albinus + + Fix an error in tramp-sh-handle-make-process. Dont' merge with master + + * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't use heredoc + script whent the argument contains a string. + +2020-10-22 Stefan Kangas + + Recommend lexical-binding in Coding Conventions + + * doc/lispref/tips.texi (Coding Conventions, Library Headers): + Recommend using lexical-binding. + +2020-10-21 Eli Zaretskii + + Avoid rare crashes while producing line numbers + + * src/xdisp.c (maybe_produce_line_number): Prevent freeing of + realized faces for as long as we are using lnum_face_id and + current_lnum_face_id for producing glyphs. (Bug#44111) + +2020-10-17 Eli Zaretskii + + Improve documentation of 'Info-hide-note-references' in info.texi + + * doc/misc/info.texi (Help-Xref): Improve the wording. + (Emacs Info Variables): Update the documentation of + 'Info-hide-note-references'. (Bug#44043) + +2020-10-17 Stefan Kangas + + * admin/release-process: Add note to update files from upstream. + + (cherry picked from commit 86dd9d12aa5a273da2efd4ce8c6e35ae343f1494) + +2020-10-17 Eli Zaretskii + + * lisp/info.el (Info-hide-note-references): Doc fix. (Bug#44043) + +2020-10-16 Alan Mackenzie + + Make lisp/progmodes/js.el dependent on CC Mode in the Makefile. + + This will prevent version mismatches between compile time and runtime + versions. This fixes bug #43037. + + * lisp/Makefile.in: Make js.el dependent on cc-{defs,engine,mode}.elc. + +2020-10-16 Eli Zaretskii + + Yet another fix for 'set-minibuffer-message' + + * lisp/minibuffer.el (set-minibuffer-message): Handle the case of + separate minibuffer-only frame. Suggested by Gregory Heytings + . + +2020-10-16 Eli Zaretskii + + Fix posn-at-x-y in builds --without-x + + * src/keyboard.c (make_lispy_position): Don't exclude the + window_or_frame = frame case from TTY-only builds. Reported by + Jared Finder . + + * doc/lispref/commands.texi (Click Events): Document the format of + POSITION in click events on the frame's internal border. + +2020-10-15 Lars Ingebrigtsen + + Clarify the seq-reduce documentation + + * doc/lispref/sequences.texi (Sequence Functions): Ditto. + + * lisp/emacs-lisp/seq.el (seq-reduce): Clarify the order of the + arguments (bug#43995). + +2020-10-12 Michael Albinus + + Make tramp-completion-reread-directory-timeout obsolete (Bug#43932) + + * doc/misc/tramp.texi (File name completion, Frequently Asked Questions): + Remove `tramp-completion-reread-directory-timeout'. (Bug#43932) + + * etc/NEWS: Mention tramp-completion-reread-directory-timeout as obsolete. + + * lisp/net/tramp.el (tramp-completion-reread-directory-timeout): + Make it obsolete. + +2020-10-11 Gregory Heytings (tiny change) + + Fix 'message' when there's active minibuffer on another frame + + * lisp/minibuffer.el (set-minibuffer-message): Don't reuse the + active minibuffer for displaying messages unless the active + minibuffer is on the same frame as the selected window. + +2020-10-10 Stefan Monnier + + * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Doc tweak + + Try and clarify the meaning of `init-value`. + + (cherry picked from commit 46c0f28c0e4e212687e90ec0ecb239d994105a19) + +2020-10-10 Eli Zaretskii + + A better fix for bug#43886 + + * src/xfaces.c (load_color2, Fcolor_distance): Revert last change. + * src/term.c (clear_tty_hooks): Don't clear defined_color_hook. + +2020-10-09 Eli Zaretskii + + Avoid crashes when a theme is loaded with one frame suspended + + * src/xfaces.c (load_color2, Fcolor_distance): Don't try to call + the frame's defined_color_hook if the frame is suspended. + (Bug#43886) + +2020-10-09 Pankaj Jangid (tiny change) + + Removed an incorrectly placed extra word in the semantic docs + + * doc/misc/semantic.texi (Parser code): Copy edit (bug#43861). + +2020-10-08 Eli Zaretskii + + Fix current-line hscrolling when overlays change + + * src/xdisp.c (redisplay_internal): Disable "optimization 1" when + auto-hscrolling current line and we're redisplaying the selected + window. (Bug#43835) + +2020-10-08 Michael Albinus + + Extend tests for shell-command-dont-erase-buffer + + * test/lisp/simple-tests.el + (simple-tests-shell-command-dont-erase-buffer): Extend test. + + * test/lisp/net/tramp-tests.el + (tramp-test32-shell-command-dont-erase-buffer): Adapt test. Tag + it :unstable. + +2020-10-07 Hong Xu + + Clarify what ``chrooted environment means'' for TRAMP + + * doc/misc/tramp.texi (Frequently Asked Questions): Clarify what + ``chrooted environment means'' for TRAMP (bug#43839). + +2020-10-05 Daniel Martín + + Add missing full stop in MS-DOS processes documentation + + * doc/emacs/msdos-xtra.texi (MS-DOS Processes): Minor copy edig + (bug#43820). + +2020-10-05 Eli Zaretskii + + Fix merging of region face for non-ASCII characters + + * src/xdisp.c (extend_face_to_end_of_line): Restore the correct + original face used by the iterator on this line, not the ASCII + face. (Bug#43363) + +2020-10-03 Alan Third + Daniel Martín + + Make drag and drop on NS open all URLs (bug#43470) + + * lisp/term/ns-win.el (ns-drag-n-drop): Merge generic and copy + actions. + +2020-10-02 Lars Ingebrigtsen + + Fix electric-buffer-list buffer selection + + * lisp/ebuff-menu.el (electric-buffer-list): Ensure that point is + restored, which isn't always the case if + global-display-line-numbers-mode (bug#43755). This enables + selecting buffers again. + +2020-10-02 Eli Zaretskii + + * doc/misc/flymake.texi (Using Flymake): Fix a typo. (Bug#43758) + +2020-10-02 Robert Pluim + + Don't error if no GPG signing key configured + + * lisp/gnus/mml-sec.el (mml-secure-epg-sign): Partially revert + "Make mml-secure-epg-sign bug out if we can't find an identity". + It causes signing to fail for people who have not set up + mml-secure-{smime,openpgp}-sign-with-sender, which is a regression + from Emacs-26 (Bug#40118). In such a situation gpg will use its + default key. + + Do not merge to master. On master Emacs will query the user. + +2020-10-01 Michael R. Mauger + + 2020-03-29 Michael R. Mauger + + * lisp/progmodes/sql.el (sql-add-product): Re-correct argument + spec. Previous change was due to my mistake; I have + resolved back to the prior behavior (Bug#39960). + * test/lisp/progmodes/sql-tests.el (sql-test-add-product): Added + test to insure I don't make the same mistake again. + +2020-10-01 Lars Ingebrigtsen + + Make aliases introduced in previous patch obsolete + + * lisp/emacs-lisp/debug.el (debugger-toggle-locals): + (debug-help-follow): Make reinstated aliases obsolete. + +2020-10-01 Gemini Lasswell + + Restore some public debugging functions removed in Emacs 27 + + * lisp/emacs-lisp/backtrace.el (backtrace--to-string): New function. + (backtrace-to-string): Use it. Fix whitespace (bug#40728). + * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): New function. + Mark it as obsolete. + (debugger-toggle-locals, debug-help-follow): New aliases. + +2020-10-01 Michael Albinus + + Clarification in Tramp manual + + * doc/misc/tramp.texi: Harmonize "Git" spelling. + (Frequently Asked Questions): Describe Emacs version mismatch. + +2020-10-01 Michael Albinus + + Check Emacs version used for Tramp compilation + + * lisp/net/tramp-compat.el (tramp-compat-emacs-compiled-version): + New defconst. Raise a warning, when it is not equal to the Emacs + version. + +2020-09-29 Eli Zaretskii + + Don't signal an error when saving files on WdebDAV volumes + + * src/w32.c (acl_get_file): If get_file_security raises the + ERROR_ACCESS_DENIED error, treat that like unsupported ACLs. + +2020-09-28 Eli Zaretskii + + * lisp/hi-lock.el (hi-lock-find-patterns): Autoload it. (Bug#43670) + +2020-09-27 Eli Zaretskii + + Minor copyedits in the Emacs user manual + + * doc/emacs/emacs.texi (Top): Remove "real-time" from the Emacs + description; add "advanced", to be consistent with what we say in + the Introduction section. (Bug#43633) + +2020-09-26 Eli Zaretskii + + Followup to a recent change in menu-bar.el + + * lisp/fileloop.el (fileloop--operate-function): Mention in a + comment that menu-bar.el relies on the default value. + +2020-09-26 Eli Zaretskii + + Enable "Continue Tags Search" menu item only when it can be used + + * lisp/menu-bar.el (menu-bar-search-menu) : Enable + only when there was a previous tags search. (Bug#43569) + (menu-bar-replace-menu) : Enable only when + there was a previous tags-replace. + +2020-09-26 Paul Eggert + + Fix soap-client URL + + * lisp/net/soap-client.el (soap-create-envelope): + Fix URL that I broke in 2019-09-23T06:53:30Z!eggert@cs.ucla.edu. + Problem reported by Thomas Fitzsimmons. + +2020-09-25 Paul Eggert + + Fix out-of-source ‘make check’ emacs-module-tests + + Problem reported by Koki Fukuda in: + https://lists.gnu.org/r/emacs-devel/2020-07/msg00169.html + * test/Makefile.in (MODULE_CFLAGS): + Include from the same directories included from in ../src. + * test/src/emacs-module-tests.el (module/describe-function-1): + Strip path to source directory. + + (cherry picked from commit c86f3fe0d023cdd25edbbce91c5b32654f2b734e) + +2020-09-25 Eli Zaretskii + + Fix support for Zip64 zip files + + * lisp/arc-mode.el (archive-zip-summarize): Fix detection of Zip64 + central directory. Support 64-bit file size field used by Zip64. + (Bug#43597) + +2020-09-25 Eli Zaretskii + + * lisp/hi-lock.el (hi-lock-auto-select-face): Doc fix. (Bug#43600) + +2020-09-25 Eli Zaretskii + + Avoid infinite recursion with 'relative' line numbers display + + * src/xdisp.c (display_count_lines_visually): Bind + 'display-line-numbers' to 'relative' around 'start_display' as + well, since that can invoke 'move_it_to' internally, thus + causing infinite recursion. (Bug#43589) + +2020-09-20 Eli Zaretskii + + Minor improvement in the ELisp manual's Introduction + + * doc/lispref/intro.texi (Printing Notation): Clarify what + "execute code" means in this context. (Bug#43463) + +2020-09-20 Eli Zaretskii + + Mention in PROBLEMS the problems with fonts and Uniscribe + + * etc/PROBLEMS: Mention font-related problems with Uniscribe on + MS-Windows. (Bug#39340) + +2020-09-19 Eli Zaretskii + + Minor copyedits in 'line-height' documentation + + * doc/lispref/display.texi (Line Height): Describe the possible + values of the 'line-height' property in a more consistent format. + +2020-09-19 Gregor Zattler + + * doc/misc/eww.texi: Document the `w' key's double function + + * doc/misc/eww.texi (Basics): Describe what the `w' command does + in eww (bug#43517). + +2020-09-19 Eli Zaretskii + + Fix a rare segfault in syntax.c + + * src/syntax.c (Fforward_comment): Prevent the loop for COUNT < 0 + from going outside the valid range of character/byte positions. + (Bug#43499) + + * doc/lispref/syntax.texi (Syntax Class Table): Mention the + "comment-fence" and "string-fence" as alternative names of 2 + syntax classes. + +2020-09-19 Alan Mackenzie + + Add doc to syntax-propertize-function saying it must do a 100% job + + and cannot be combined with other ways of applying syntax-table text + properties. + + * lisp/emacs-lisp/syntax.el (syntax-propertize-function): Amend doc string. + + * doc/lispref/syntax.texi (Syntax Properties): Amend the description of the + variable. + +2020-09-19 Eli Zaretskii + + Minor copyedits of doc of 'with-silent-modifications' + + * doc/lispref/text.texi (Changing Properties): + * doc/lispref/buffers.texi (Buffer Modification): Improve + documentation and indexing of 'with-silent-modifications'. + +2020-09-18 Eli Zaretskii + + Improve documentation of 'max-mini-window-height' + + * src/xdisp.c (syms_of_xdisp): + * doc/lispref/minibuf.texi (Minibuffer Windows): More accurate + wording in the documentation of 'max-mini-window-height', to + clarify the meaning of an integer value. + +2020-09-18 Daniel Martín + + Use modern constant names for the NS pasteboard + + Use the same pasteboard constant names defined in + ns_drag_types. (Bug#43470). + + * src/nsterm.m: Rename NSURLPboardType to NSPasteboardTypeURL, + NSStringPboardType to NSPasteboardTypeString, and + NSTabularTextPboardType to NSPasteboardTypeTabularText + +2020-09-16 Eli Zaretskii + + Fix doc string of 'toggle-menu-bar-mode-from-frame' + + * lisp/menu-bar.el (toggle-menu-bar-mode-from-frame): Improve the + wording of the doc string. (Bug#43383) + +2020-09-12 Glenn Morris + + Make vc-bzr tests work with brz 3.1 (bug#43314) + + * test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726) + (vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads): + Make them work with brz 3.1. + +2020-09-12 Lars Ingebrigtsen + + diff-no-select doc string clarification + + * lisp/vc/diff.el (diff-no-select): Update doc string from the trunk, + don't merge. + +2020-09-12 Eli Zaretskii + + Fix compilation on TERMINFO platforms with GCC 10 + + * src/terminfo.c [TERMINFO]: Don't redefine UP, BC, and CP, as + that could cause linking errors due to multiple definitions. + (Bug#43195) + +2020-09-10 Lars Ingebrigtsen + + Fix the font-lock-debug-fontify NEWS entry + + * etc/NEWS: Fix the name of `font-lock-debug-fontify' (bug#43319). + +2020-09-08 Eli Zaretskii + + Avoid crashes when trying to load bad GIF files + + * src/image.c (gif_load): Handle the case when GifErrorString + returns NULL. (Bug#43281) + +2020-09-04 Alan Mackenzie + + C++ Mode: handle comma separated brace initializers. + + This includes both indentation and fontification. + + * lisp/progmodes/cc-engine.el (c-do-declarators): Handle brace initializers + without = correctly. + (c-looking-at-or-maybe-in-bracelist): Use c-do-declarators with a simple + inline function to check that after-type-id-pos points to the start of a + declarator. + + * lisp/progmodes/cc-langs.el (c-recognize-bare-brace-inits): New lang + const/variable. + +2020-09-04 Stefan Monnier + + * lisp/display-fill-column-indicator.el: Fix bug#41145 + + (global-display-fill-column-indicator-mode): Specify the implicit + defustom's group explicitly. + + * lisp/cus-dep.el (custom-make-dependencies): Also look at + define(-globalized)-minor-mode since it can also define custom vars. + +2020-09-04 Michael Albinus + + Backport recent change in tramp-tests.el from master, don't merge + + * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name): + No need to expect different results in Emacs 28 and later. + +2020-09-03 Michael Albinus + + Fix bug in dbus.el; do not merge with master + + * lisp/net/dbus.el (dbus-register-property) + (dbus-property-handler): Handle properties of the same interface + at different object paths properly. (Bug#43146) + +2020-09-01 Stefan Kangas + + Fix help message with help-window-select + + * lisp/help.el (help-print-return-message): + (help-window-display-message): Recommend 'scroll-up-command' instead + of 'scroll-up' when 'help-window-select' is non-nil. (Bug#43122) + +2020-08-31 Eric Abrahamsen + + Remove obsolete "Wide Characters" section of Gnus manual + + * doc/misc/gnus.texi: This hasn't been valid since 2016. + +2020-08-31 Stefan Kangas + + Fix typo in Introduction to Emacs Lisp + + * doc/lispintro/emacs-lisp-intro.texi (type-of-animal in detail): + Remove extraneous parenthesis. + +2020-08-30 Stefan Kangas + + Update Elisp Manual reference to which-function-mode + + * doc/lispref/modes.texi (Mode Line Top, Mode Line Variables) + Don't refer to obsolete alias for 'which-function-mode'. + (Bug#13716) + +2020-08-30 Michael Albinus + + Some precisions to bug handling + + * admin/admin.el (reminder-for-release-blocking-bugs): Add date to subject. + + * admin/notes/bug-triage: + * admin/notes/bugtracker: Minor precisions. + +2020-08-29 Alan Mackenzie + + CC Mode: Fix processing for when c-multiline-string-start-char is a character + + * lisp/progmodes/cc-mode.el (c-pps-to-string-delim) + (c-multiline-string-check-final-quote): Replace c-clear-char-property by + c-clear-syn-tab. + (c-multiline-string-check-final-quote): Replace c-put-char-property by + c-put-syn-tab. + +2020-08-29 Eli Zaretskii + + Fix description of %-constructs in 'mode-line-format' + + * doc/lispref/modes.texi (%-Constructs): Document %@ and remove + %M, which is no longer supported. (Bug#43092) + +2020-08-27 Michael Albinus + + Adapt tramp-tests.el, don't merge with master + + * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name) + (tramp-test05-expand-file-name-relative): Adapt tests. + (tramp--test-emacs28-p): New defun. + +2020-08-27 Michael Albinus + + Adapt reminder-for-release-blocking-bugs + + * admin/admin.el (reminder-for-release-blocking-bugs): + Require `debbugs-gnu' also in `interactive' form. + + * admin/release-process: Rename RELEASE-CRITICAL to RELEASE-BLOCKING. + Adapt Emacs version. Describe `reminder-for-release-blocking-bugs'. + +2020-08-25 Paul Eggert + + Fix replace-region-contents performance bug + + Backport from master. + * src/editfns.c (rbc_quitcounter): Remove; the quitcounter + is now part of the context. + (EXTRA_CONTEXT_FIELDS): Remove unused member early_abort_tests. + Add jmp, quitcounter. + (Freplace_buffer_contents): Use setjmp/longjmp to recover from + a compareseq that runs too long. Omit unnecessary rarely_quit + call. + (buffer_chars_equal): Occasionally check for early abort and + longjmp out if so (Bug#43016). + +2020-08-25 Michael Albinus + + * admin/admin.el (reminder-for-release-blocking-bugs): New command. + +2020-08-25 Michael Albinus + + Sync with Tramp 2.4.5-pre + + * doc/misc/tramp.texi: Adapt Tramp and Emacs version numbers. + (Remote processes): Describe `process-file-return-signal-string' + and $INSIDE_EMACS. + (Frequently Asked Questions): Mention Emacs 28. + Describe `tramp-smb-options'. + + * doc/misc/trampver.texi: Change version to "2.4.5-pre". + + * lisp/net/tramp-adb.el (process-file-return-signal-string): Declare. + (tramp-adb-handle-write-region): Flush the cache after the file + has been written. + (tramp-adb-handle-set-file-modes, tramp-adb-handle-set-file-times): + Add optional _FLAG. + (tramp-adb-handle-copy-file, tramp-adb-handle-rename-file) + (tramp-adb-handle-process-file): Use `tramp-file-local-name'. + (tramp-adb-get-signal-strings): New defun. + (tramp-adb-handle-process-file): Use it. + (tramp-adb-handle-make-process): Implement `stderr'. Use + `insert-file-contents-literally'. + (tramp-adb-send-command-and-check): Add optional argument + EXIT-STATUS. + (tramp-adb-handle-process-file): Use it. + + * lisp/net/tramp-archive.el (tramp-archive-file-name-handler): + Increase `max-specpdl-size' temporarily. + + * lisp/net/tramp-cache.el (top): + Use `insert-file-contents-literally'. + + * lisp/net/tramp-cmds.el (tramp-rename-files): + Use `tramp-file-local-name'. + + * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Prevent crash for + older Emacsen. + (top): Adapt `tramp-gvfs-unload-hook'. + (tramp-gvfs-handle-file-system-info): Fix error. + (tramp-gvfs-handle-set-file-modes, tramp-gvfs-handle-set-file-times): + Add optional _FLAG. + + * lisp/net/tramp-rclone.el (tramp-rclone-flush-directory-cache): + Fix a problem with older Emacsen. + + * lisp/net/tramp-sh.el (process-file-return-signal-string): Declare. + (tramp-sh-extra-args): Add "-noediting" as bash arg. + (tramp-hexdump-encode, tramp-hexdump-awk-encode) + (tramp-od-encode, tramp-od-awk-encode): New defconst. + (tramp-awk-encode, tramp-awk-decode): Adapt. + (tramp-awk-coding-test): Remove. + (tramp-remote-coding-commands): Add hexdump/awk encoding. (Bug#35639) + (tramp-find-inline-encoding): Adapt handling of awk, hexdump and od. + (tramp-get-remote-busybox, tramp-get-remote-awk) + (tramp-get-remote-hexdump, tramp-get-remote-od): New defuns. + (tramp-sh-handle-make-symbolic-link): + (tramp-do-copy-or-rename-file-directly) + (tramp-sh-handle-process-file, tramp-set-remote-path) + (tramp-find-inline-encoding, tramp-get-remote-touch): + Use `tramp-file-local-name'. + (tramp-do-file-attributes-with-stat): Simplify shell command. + Suppress errors (interpret as nil). + (tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times): + Add optional _FLAG. + (tramp-sh-handle-make-process): Do not visit with + `insert-file-contents'. Delete tmp file only if exists. Support + `stderr' as file name. Delete temporary stderr file. Flush + connection properties in time. + (tramp-sh-get-signal-strings): New defun. + (tramp-sh-handle-process-file): Use it. + (tramp-sh-handle-write-region): Copy to temp file only if FILENAME + exists. (Bug#40156) + (tramp-set-remote-path): Send the command in several chunks if it + is too large. (Bug#42538) + (tramp-open-connection-setup-interactive-shell): Move up "set +o + vi +o emacs" command. (Bug#39399) + (tramp-send-command-and-read): Suppress `signal-hook-function' + when reading expression. + (tramp-send-command-and-check): Add optional argument EXIT-STATUS. + (tramp-sh-handle-process-file): Use it. (Bug#41099) + + * lisp/net/tramp-smb.el (tramp-smb-conf): Fix docstring. + (tramp-smb-options): New defcustom. + (tramp-smb-handle-copy-directory, tramp-smb-handle-file-acl) + (tramp-smb-handle-set-file-acl, tramp-smb-maybe-open-connection): + Use it. + (tramp-smb-errors): Add "NT_STATUS_INVALID_PARAMETER". + (tramp-smb-handle-make-symbolic-link) + (tramp-smb-handle-process-file): Use `tramp-file-local-name'. + + * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): + (tramp-sudoedit-handle-set-file-uid-gid): + Use `tramp-unquote-file-local-name'. + (tramp-sudoedit-handle-make-symbolic-link): + Use `tramp-file-local-name'. + (tramp-sudoedit-handle-file-system-info): Fix a scoping error. + (tramp-sudoedit-handle-set-file-modes): + (tramp-sudoedit-handle-set-file-times): Add optional _FLAG. + + * lisp/net/tramp.el: Bump version to 2.4.5-pre. + (tramp-file-local-name, tramp-unquote-file-local-name): New defuns. + (tramp-set-connection-local-variables-for-buffer) + (tramp-equal-remote, tramp-handle-make-auto-save-file-name): + Use `tramp-tramp-file-p'. + (tramp-parse-file): Use `insert-file-contents-literally'. + (tramp-handle-file-modes, tramp-handle-file-times): + Add optional _FLAG. + (tramp-handle-shell-command): Fix `window-start' in output buffer. + (Bug#39171) + Handle `shell-command-dont-erase-buffer'. (Bug#39067) + Reorganize error-buffer handling. Set `default-directory'. + (Bug#39253) + (tramp-handle-shell-command, tramp-handle-start-file-process): + Implement asynchronous `error-buffer'. + (tramp-action-process-alive): Read pending output. + (tramp-read-passwd): Use `tramp-compat-temporary-file-directory'. + (Bug#39389, Bug#39489) + (tramp-interrupt-process): Improve command. + + * lisp/net/trampver.el: Change version to "2.4.5-pre". + (tramp-repository-branch, tramp-repository-version): + Bind `debug-on-error' to nil. + + * test/lisp/net/tramp-tests.el (tramp-get-remote-gid) + (process-file-return-signal-string) + (shell-command-dont-erase-buffer): Declare. + (tramp-test10-write-region, tramp-test28-process-file) + (tramp-test29-start-file-process, tramp-test30-make-process) + (tramp-test31-interrupt-process, tramp-test32-shell-command): + Extend test. + (tramp-test10-write-region, tramp-test21-file-links): Use function + symbols. + (tramp-test18-file-attributes): Check `file-ownership-preserved-p' + only if possible. + (tramp--test-async-shell-command): New defun. + (tramp--test-shell-command-to-string-asynchronously): Use it. + (tramp-test32-shell-command-dont-erase-buffer): New test. + +2020-08-24 Phillip Lord + + Fix error in GMP test + + * etc/w32-feature.el: Update to use system-configuration-features for + GMP test. + +2020-08-24 Phillip Lord + + Add Feature testing for Windows binaries + + * etc/w32-feature.el: New file + +2020-08-20 Stefan Kangas + + Revert "; * etc/NEWS: Remove temporary note on documentation. (Bug#42917)" + + This reverts commit 121be3e1181e609734fc4cc9d2d54cf7eec18ab2. + +2020-08-19 Glenn Morris + + * admin/admin.el (set-version): Trap yet another NEWS error. + +2020-08-19 Mattias Engdegård + + Fix cond jump table compilation (bug#42919) + + This bug affected compilation of + + (cond ((member '(some list) variable) ...) ...) + + While equal is symmetric, member is not; in the latter case the + arguments must be a variable and a constant list, in that order. + + Reported by Ikumi Keita. + + * lisp/emacs-lisp/bytecomp.el (byte-compile--cond-switch-prefix): + Don't treat equality and member predicates in the same way; only + the former are symmetric in their arguments. + * test/lisp/emacs-lisp/bytecomp-tests.el + (byte-opt-testsuite-arith-data): Add test cases. + +2020-08-17 Paul Eggert + + Let Emacs start even if curdir is inaccessible + + * lisp/startup.el (normal-top-level): Also delete PWD if + file-attributes fails for either $PWD or default-directory, + instead of failing out of the top level. + This fixes a regression from Emacs 26 (Bug#42903). + +2020-08-17 Paul Eggert + + * etc/NEWS: Mention GnuPG 2.0 through 2.1.5 issue (Bug#42845). + +2020-08-17 Robert Pluim + + Fix bug with ~/Emacs file not being read at init + + * src/xrdb.c (get_user_app): Put "/" between homedir + and %L or %N (Bug#42827). + +2020-08-15 Tino Calancha + + Prevent from frozen frame after `C-z' in Lucid builds + + Some WMs (e.g. mutter in Gnome Shell) don't unmap iconized windows, + thus we won't get a MapNotify when deconifying them. + Check if we are deconifying a window elsewhere (Bug#42655). + + - src/xterm.c (handle_one_xevent): + Check for window deconify when receiving a FocusIn signal. + +2020-08-15 Eli Zaretskii + + Document the 'flex' completion style + + * doc/emacs/mini.texi (Completion Styles): Document the 'flex' + completion style. (Bug#42763) + +2020-08-14 Lars Ingebrigtsen + + Note that Emacs needs systemd support if systemd is used to stop/start + + * etc/NEWS: Note that Emacs needs to be built with systemd support + systemd is used to stop/start Emacs (bug#42242). Change suggested by + Bhavin Gandhi + +2020-08-14 Mattias Engdegård + + Regexps cannot infloop; fix manual + + * doc/lispref/searching.texi (Regexp Special): Edit erroneous + statements about infinite looping in regexps. + + (cherry picked from commit 63268253d21c57d991cba3f3b083d74f154a26fe) + +2020-08-13 Paul Eggert + + Fix startup working dir bug on NeXTSTEP + + * src/emacs.c (main) [NS_IMPL_COCOA]: Update emacs_wd + after a NS GUI chdirs successfully (Bug#42836). + +2020-08-13 Eli Zaretskii + + Improve documentation of function argument lists + + * doc/lispref/functions.texi (Lambda Components) + (Defining Functions): Add a cross-reference to "Argument List". + (Argument List): Improve the section name. (Bug#42750) + +2020-08-13 Eli Zaretskii + + Improve documentation of special events + + * doc/lispref/commands.texi (Misc Events): Explain how to bind + special events to commands. + +2020-08-13 Eli Zaretskii + + Fix face merging at EOL when inherited face specifies :extend + + * src/xfaces.c (merge_face_ref): Handle correctly faces that + inherit from another, and in addition specify :extend. + (Bug#42552) + + (cherry picked from commit 39c90f8dfabe158ad7ac9243aa9b9dedb9409e19) + +2020-08-13 Eli Zaretskii + + Fix face extension past EOL in overlay strings + + * src/xdisp.c (face_at_pos): Pass ATTR_FILTER to + face_for_overlay_string. + * src/xfaces.c (face_for_overlay_string): Accept an additional + argument ATTR_INDEX and pass it to merge_face_ref for merging the + face at POS. This ensures a face from buffer text will not be + merged unless it specifies the :extend attribute. (Bug#42552) + * src/dispextern.h (face_for_overlay_string): Adjust prototype. + + (cherry picked from commit 35564bea4d73bc266743216599d01d644aed6fd8) + +2020-08-12 Phil Sainty + + Fix comint-redirect-results-list regexp usage (Bug#42662) + + * lisp/comint.el (comint-redirect-results-list-from-process): + Don't treat the literal string argument COMMAND as a regexp. + +2020-08-04 Nicolas Petton + + * etc/HISTORY: Update the Emacs 27.1 release date. + 2020-08-03 Phil Sainty lisp/so-long.el: Improve support for major mode hooks @@ -142478,7 +144118,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit 1ca4da054be7eb340c511d817f3ec89c8b819db7 (inclusive). +commit 48b9c47805fc304441017f6ee4c114212cdb0496 (inclusive). See ChangeLog.2 for earlier changes. ;; Local Variables: diff --git a/README b/README index 279a66b3aff..8f7649ca842 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2020 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 27.1.50 of GNU Emacs, the extensible, +This directory tree holds version 27.1.90 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 ff159726aa2..e93a3331b72 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, 27.1.50, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) +AC_INIT(GNU Emacs, 27.1.90, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) 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/AUTHORS b/etc/AUTHORS index c2b5d9ddd2b..96948415570 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -64,7 +64,7 @@ Adrian Robert: co-wrote ns-win.el and changed nsterm.m nsfns.m nsfont.m nsterm.h nsmenu.m configure.ac src/Makefile.in macos.texi README config.in emacs.c font.c keyboard.c nsgui.h nsimage.m xdisp.c image.c lib-src/Makefile.in lisp.h menu.c - Makefile.in and 78 other files + Makefile.in and 79 other files Ævar Arnfjörð Bjarmason: changed rcirc.el @@ -85,6 +85,8 @@ and changed cc-mode.el perl-mode.el Akinori Musha: changed ruby-mode.el Makefile.in sieve-mode.el +Akira Kyle: changed eww.el + Aki Vehtari: changed bibtex.el gnus-art.el gnus-score.el gnus-sum.el nnmail.el tar-mode.el @@ -98,10 +100,10 @@ Alan Mackenzie: wrote cc-awk.el and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-fonts.el cc-langs.el cc-mode.el cc-styles.el cc-vars.el and changed cc-mode.texi bytecomp.el display.texi follow.el subr.el - edebug.el progmodes/compile.el programs.texi syntax.texi modes.texi - font-lock.el isearch.el text.texi help.el ispell.el lread.c syntax.c - windows.texi .dir-locals.el control.texi cus-start.el - and 148 other files + edebug.el syntax.texi progmodes/compile.el programs.texi modes.texi + font-lock.el isearch.el text.texi help.el ispell.el lread.c + newcomment.el syntax.c windows.texi .dir-locals.el control.texi + and 150 other files Alan Modra: changed unexelf.c @@ -112,9 +114,9 @@ Alan Shutko: changed diary-lib.el calendar.el bindings.el cal-hebrew.el solar.el Alan Third: wrote dabbrev-tests.el image-transforms-tests.el -and changed nsterm.m nsterm.h nsfns.m nsmenu.m ns-win.el nsimage.m - image.c macfont.m configure.ac frame.el xdisp.c macos.texi display.texi - image.el xterm.c Info.plist.in conf_post.h dispextern.h frame.c frame.h +and changed nsterm.m nsterm.h nsfns.m ns-win.el nsmenu.m nsimage.m + image.c macfont.m configure.ac frame.el xdisp.c macos.texi dispextern.h + display.texi image.el xterm.c Info.plist.in conf_post.h frame.c frame.h frames.texi and 21 other files Alastair Burt: changed gnus-art.el smiley.el @@ -398,11 +400,11 @@ Ansgar Burchardt: changed latin-ltx.el Antoine Beaupré: changed vc-git.el -Antoine Levitt: changed gnus-group.el gnus-sum.el message.texi ada-prj.el +Antoine Levitt: changed gnus-group.el gnus-sum.el message.texi ange-ftp.el cus-edit.el dired-x.el ebnf2ps.el emerge.el erc-button.el erc-goodies.el erc-stamp.el erc-track.el files.el find-file.el gnus-art.el gnus-uu.el gnus.el gnus.texi message.el mh-funcs.el - and 8 other files + mh-mime.el and 7 other files Antonin Houska: changed newcomment.el @@ -488,7 +490,7 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el hexl.el icon.el xscheme.el Basil L. Contovounesios: changed simple.el message.el subr.el text.texi - gravatar.el modes.texi custom.el customize.texi display.texi eww.el + custom.el gravatar.el modes.texi customize.texi display.texi eww.el files.texi gnus-group.el gnus-sum.el gnus-win.el internals.texi window.c bibtex.el button.el gnus-art.el gnus-msg.el gnus.texi and 182 other files @@ -499,10 +501,10 @@ Bastian Beischer: changed semantic/complete.el include.el mru-bookmark.el Bastien Guerry: wrote gnus-bookmark.el and co-wrote ol-bibtex.el org-list.el org-protocol.el org-src.el and changed org.el org-agenda.el org.texi ox-html.el org-clock.el - org-capture.el org-table.el ox-latex.el ox.el ox-odt.el org-compat.el - ox-publish.el ob.el org-mobile.el org-colview.el org-macs.el - org-pcomplete.el org-timer.el org-faces.el ox-ascii.el org-archive.el - and 120 other files + org-capture.el org-table.el ox-latex.el org-exp.el ox-odt.el + org-compat.el ob.el org-mobile.el org-colview.el org-publish.el ox.el + org-macs.el org-pcomplete.el org-timer.el org-faces.el ox-ascii.el + and 123 other files Ben A. Mesander: co-wrote erc-dcc.el @@ -619,7 +621,7 @@ and changed fill.el simple.el indent.el paragraphs.el cmds.c intervals.c text-mode.el textprop.c ada.el allout.el awk-mode.el bibtex.el buffer.c buffer.h c-mode.el and 38 other files -Boris Samorodov: changed imap.el +Boris Samorodov: changed net/imap.el Boruch Baum: co-wrote footnote.el and changed bookmark.el @@ -708,17 +710,18 @@ Carsten Dominik: wrote idlw-complete-structtag.el idlw-toolbar.el org-capture.el org-clock.el org-colview.el org-compat.el org-datetree.el org-faces.el org-feed.el org-footnote.el org-goto.el org-id.el org-indent.el org-inlinetask.el org-macs.el org-mobile.el - org-table.el org-timer.el org.el reftex-auc.el reftex-cite.el - reftex-dcr.el reftex-global.el reftex-index.el reftex-parse.el - reftex-ref.el reftex-sel.el reftex-toc.el reftex-vars.el reftex.el + org-refile.el org-table.el org-timer.el org.el reftex-auc.el + reftex-cite.el reftex-dcr.el reftex-global.el reftex-index.el + reftex-parse.el reftex-ref.el reftex-sel.el reftex-toc.el + reftex-vars.el reftex.el and co-wrote idlw-help.el idlw-shell.el idlwave.el ol-bbdb.el ol-bibtex.el ol-gnus.el org-entities.el org-list.el org-pcomplete.el org-src.el ox-beamer.el ox-html.el ox-icalendar.el -and changed ox.el ox-latex.el org.texi org-remember.el orgcard.tex - ox-publish.el org-docbook.el ox-ascii.el org-attach.el org-bbdb.el - org-gnus.el org-protocol.el org-mouse.el org-mac-message.el org-wl.el - ox-jsinfo.el org-crypt.el org-freemind.el idlw-rinfo.el - org-exp-blocks.el org-habit.el and 40 other files +and changed org-exp.el ox-latex.el org.texi org-publish.el + org-remember.el orgcard.tex org-export-latex.el org-docbook.el + ox-ascii.el org-attach.el org-bbdb.el org-gnus.el org-protocol.el + org-mouse.el org-jsinfo.el org-mac-message.el org-wl.el org-crypt.el + org-freemind.el idlw-rinfo.el org-exp-blocks.el and 40 other files Caveh Jalali: changed configure.ac intel386.h sol2-4.h @@ -766,7 +769,7 @@ and co-wrote longlines.el tango-dark-theme.el tango-theme.el and changed simple.el display.texi xdisp.c files.el frames.texi cus-edit.el files.texi custom.el subr.el text.texi faces.el keyboard.c startup.el package.el misc.texi emacs.texi modes.texi mouse.el - custom.texi image.c window.el and 933 other files + custom.texi image.c window.el and 932 other files Chris Chase: co-wrote idlw-shell.el idlwave.el @@ -855,7 +858,7 @@ Christopher Allan Webber: changed gamegrid.el org-agenda.el tetris.el Christopher Genovese: changed ibuf-ext.el ibuffer-tests.el assoc.el help-fns.el ibuffer.el -Christophe Rhodes: changed ox-latex.el ox.el +Christophe Rhodes: changed org-exp.el ox-latex.el Christopher J. Madsen: wrote decipher.el and changed replace.el files.el ispell.el time.el @@ -900,11 +903,13 @@ Claudio Bley: changed image.c image.el process.c stat.h w32-win.el w32.c Claudio Fontana: changed Makefile.in leim/Makefile.in lib-src/Makefile.in -Clément Pit--Claudel: changed debugging.texi emacs-lisp/debug.el eval.c - progmodes/python.el subr-tests.el subr.el url-http.el url-vars.el +Clemens Radermacher: changed cus-start.el frame.c minibuf.texi window.el Clément Pit-Claudel: changed display.texi keyboard.c text.texi xdisp.c +Clément Pit--Claudel: changed debugging.texi emacs-lisp/debug.el eval.c + progmodes/python.el subr-tests.el subr.el url-http.el url-vars.el + Colin Marquardt: changed gnus.el message.el Colin Rafferty: changed message.el @@ -968,10 +973,10 @@ Dan Christensen: changed gnus-sum.el nndoc.el nnfolder.el gnus-art.el Dan Davison: wrote ob-matlab.el ob-octave.el and co-wrote ob-R.el ob-core.el ob-exp.el ob-lob.el ob-perl.el ob-python.el ob-ref.el org-src.el -and changed ob.el ob-sh.el org.el ox.el ox-latex.el ob-tangle.el ob-C.el - ob-asymptote.el ob-clojure.el ob-haskell.el ob-ruby.el ob-scheme.el - ob-table.el ob-ditaa.el ob-dot.el ob-gnuplot.el ob-js.el ob-mscgen.el - ob-ocaml.el ob-org.el ob-plantuml.el and 14 other files +and changed ob.el ob-sh.el org-exp.el org.el ox-latex.el ob-tangle.el + ob-C.el ob-asymptote.el ob-clojure.el ob-haskell.el ob-ruby.el + ob-scheme.el ob-table.el ob-ditaa.el ob-dot.el ob-gnuplot.el ob-js.el + ob-mscgen.el ob-ocaml.el ob-org.el ob-plantuml.el and 14 other files Daniel Barrett: changed dbnotn.rnc @@ -990,7 +995,7 @@ and changed keyboard.c emacs.c w32fns.c alloc.c image.c cl-macs.el lisp.h and 216 other files Daniel Dehennin: changed gnus-mlspl.el mml2015.el gnus-msg.el gnus.texi - mm-decode.el nnmail.el ox.el + mm-decode.el nnmail.el org-exp.el Daniel E. Doherty: changed calc.texi @@ -1021,6 +1026,8 @@ Daniel Lopez: changed progmodes/compile.el Daniel Lublin: changed dns-mode.el +Daniel Martín: changed erc.texi msdos-xtra.texi ns-win.el nsterm.m + Daniel McClanahan: changed lisp-mode.el Daniel M Coffman: changed arc-mode.el @@ -1095,7 +1102,7 @@ and co-wrote latin-ltx.el socks.el and changed configure.ac help.el mule-cmds.el fortran.el mule-conf.el xterm.c browse-url.el mule.el coding.c src/Makefile.in european.el fns.c mule-diag.el simple.el wid-edit.el cus-edit.el cus-start.el - files.el keyboard.c byte-opt.el info.el and 772 other files + files.el keyboard.c byte-opt.el info.el and 773 other files Dave Pearson: wrote 5x5.el quickurl.el @@ -1131,8 +1138,8 @@ David De La Harpe Golden: changed files.el mouse.el simple.el fileio.c cus-start.el nsselect.m select.el w32-fns.el x-win.el xterm.c David Edmondson: changed message.el erc.el mml2015.el process.c - gnus-cite.el imap.el mm-uu.el mm-view.el nnfolder.el nnimap.el nnml.el - rcirc.el shr.el + gnus-cite.el mm-uu.el mm-view.el net/imap.el nnfolder.el nnimap.el + nnml.el rcirc.el shr.el David Engster: wrote mairix.el nnmairix.el and co-wrote gitmerge.el @@ -1189,9 +1196,9 @@ David Lawrence: changed comint.el simple.el files.el c++-mode.el David Lord: changed timeclock.el -David Maus: changed org.el org-agenda.el ox.el org-feed.el org-wl.el +David Maus: changed org.el org-agenda.el org-exp.el org-feed.el org-wl.el org-macs.el ox-html.el org-capture.el org.texi org-gnus.el org-bbdb.el - org-clock.el org-protocol.el ox-publish.el ob-haskell.el ob.el + org-clock.el org-protocol.el org-publish.el ob-haskell.el ob.el org-bibtex.el org-compat.el org-footnote.el org-id.el org-list.el and 20 other files @@ -1263,10 +1270,10 @@ Debarshi Ray: changed erc-backend.el erc.el Decklin Foster: changed nngateway.el -Deepak Goel: changed idlw-shell.el ada-xref.el feedmail.el files.el - find-func.el flymake.el mh-search.el mh-seq.el mh-thread.el mh-xface.el - org.el simple.el vc.el vhdl-mode.el wdired.el README ada-mode.el - allout.el appt.el apropos.el artist.el and 85 other files +Deepak Goel: changed idlw-shell.el feedmail.el files.el find-func.el + flymake.el mh-search.el mh-seq.el mh-thread.el mh-xface.el org.el + simple.el vc.el vhdl-mode.el wdired.el README allout.el appt.el + apropos.el artist.el bibtex.el bindings.el and 83 other files D. E. Evans: changed basic.texi @@ -1288,7 +1295,7 @@ Dennis Gilmore: changed sparc.h Denys Duchier: changed pop3.el -Derek Atkins: changed imap.el pgg-pgp.el +Derek Atkins: changed net/imap.el pgg-pgp.el Derek L. Davies: changed gud.el @@ -1357,7 +1364,7 @@ Dmitry Gutov: wrote elisp-mode-tests.el jit-lock-tests.el json-tests.el vc-hg-tests.el xref-tests.el and changed ruby-mode.el xref.el project.el vc-git.el elisp-mode.el etags.el ruby-mode-tests.el js.el package.el vc-hg.el vc.el - symref/grep.el log-edit.el simple.el dired-aux.el minibuffer.el + symref/grep.el dired-aux.el log-edit.el simple.el minibuffer.el menu-bar.el package-test.el progmodes/grep.el vc-svn.el eldoc.el and 112 other files @@ -1392,11 +1399,13 @@ and changed dired.el cus-edit.el imenu.el info.el ls-lisp.el faces.el mouse.el ange-ftp.el apropos.el bindings.el bookmark.el custom.el descr-text.el dired-aux.el dired.texi and 18 other files +Earl Hyatt: changed windows.texi + E. Choroba: changed simple.el Edison Ibañez: changed auth-source-pass-tests.el -Ed L. Cashin: changed gnus-sum.el imap.el +Ed L. Cashin: changed gnus-sum.el net/imap.el Ed Swarthout: changed hexl.el textmodes/table.el @@ -1445,9 +1454,9 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c] chartab-tests.el coding-tests.el doc-tests.el etags-tests.el rxvt.el tty-colors.el and changed xdisp.c msdos.c w32.c display.texi w32fns.c simple.el - files.el fileio.c keyboard.c w32term.c emacs.c w32proc.c files.texi - text.texi dispnew.c frames.texi lisp.h dispextern.h window.c process.c - term.c and 1191 other files + files.el fileio.c keyboard.c w32term.c emacs.c w32proc.c text.texi + dispnew.c files.texi frames.texi lisp.h dispextern.h window.c term.c + process.c and 1192 other files Emanuele Giaquinta: changed configure.ac rxvt.el charset.c etags.c fontset.c frame.el gnus-faq.texi loadup.el lread.c sh-script.el @@ -1462,7 +1471,7 @@ Emilio C. Lopes: changed woman.el cmuscheme.el help.el vc.el advice.el and 57 other files Emmanuel Briot: wrote xml.el -and changed ada-mode.el ada-stmt.el ada-prj.el ada-xref.el +and changed ada-stmt.el Era Eriksson: changed bibtex.el dired.el json.el ses.el ses.texi shell.el tramp.el tramp.texi @@ -1532,7 +1541,7 @@ and changed c.srt ede.texi info.el rmail.el speedbspec.el cedet.el ede-autoconf.srt ede-make.srt eieio.texi gud.el sb-dir-minus.xpm sb-dir-plus.xpm sb-dir.xpm sb-mail.xpm sb-pg-minus.xpm sb-pg-plus.xpm sb-pg.xpm sb-tag-gt.xpm sb-tag-minus.xpm sb-tag-plus.xpm - and 50 other files + and 51 other files Eric Schulte: wrote ob-asymptote.el ob-awk.el ob-calc.el ob-comint.el ob-coq.el ob-css.el ob-ditaa.el ob-dot.el ob-emacs-lisp.el ob-eval.el @@ -1544,10 +1553,10 @@ and co-wrote ob-C.el ob-R.el ob-core.el ob-exp.el ob-fortran.el ob-lisp.el ob-lob.el ob-maxima.el ob-perl.el ob-picolisp.el ob-python.el ob-ref.el ob-scheme.el ol-bibtex.el and changed org.texi org.el ob-clojure.el org-exp-blocks.el ob-sh.el - org-bibtex.el ox.el ox-latex.el org-src.el ob-plantuml.el ob-keys.el - ob-screen.el org-macs.el org-table.el org-agenda.el org-mouse.el - orgcard.tex ob-lilypond.el ob-mscgen.el ob-octave.el org-clock.el - and 16 other files + org-bibtex.el org-exp.el ox-latex.el org-src.el ob-plantuml.el + ob-keys.el ob-screen.el org-macs.el org-table.el org-agenda.el + org-mouse.el orgcard.tex ob-lilypond.el ob-mscgen.el ob-octave.el + org-clock.el and 16 other files Eric S Fraga: wrote ob-ledger.el and co-wrote ob-maxima.el @@ -1592,7 +1601,7 @@ Ethan Bradford: changed ispell.el ange-ftp.el gnus.el gnuspost.el lpr.el Ethan Ligon: changed org-docbook.el ox-html.el -Etienne Prud'homme: changed align.el +Etienne Prud'Homme: changed align.el Etienne Prud’Homme: changed css-mode-tests.el css-mode.el @@ -1659,7 +1668,8 @@ Felix S. T. Wu: co-wrote vi.el (public domain) Feng Li: changed calc-ext.el pascal.el which-func.el -Feng Shu: changed org.el org.texi ox.el ox-html.el ox-latex.el ox-odt.el +Feng Shu: changed org.el org.texi org-exp.el ox-html.el ox-latex.el + ox-odt.el ox.el Ferenc Wagner: changed nnweb.el @@ -1790,7 +1800,8 @@ Gary Oberbrunner: changed gud.el Gary Wong: changed termcap.c tparam.c -Gaute B Strokkenes: changed imap.el gnus-fun.el mail-source.el process.c +Gaute B Strokkenes: changed net/imap.el gnus-fun.el mail-source.el + process.c G Dinesh Dutt: changed etags.el @@ -1799,7 +1810,7 @@ Geert Kloosterman: changed which-func.el Gemini Lasswell: wrote backtrace-tests.el backtrace.el edebug-tests.el kmacro-tests.el testcover-tests.el thread-tests.el thread.el and changed edebug.el cl-print.el edebug.texi cl-print-tests.el - debugging.texi cl-macs.el emacs-lisp/debug.el edebug-test-code.el + debugging.texi emacs-lisp/debug.el cl-macs.el edebug-test-code.el subr.el testcases.el testcover.el cl-generic.el ert-x.el eval.c eieio-compat.el elisp.texi ert.el ert.texi eval-tests.el generator.el print.c and 24 other files @@ -1833,7 +1844,7 @@ Gerd Möllmann: wrote authors.el ebrowse.el jit-lock.el tooltip.el and changed xdisp.c xterm.c dispnew.c dispextern.h xfns.c xfaces.c window.c keyboard.c lisp.h faces.el alloc.c buffer.c startup.el xterm.h fns.c simple.el term.c configure.ac frame.c xmenu.c emacs.c - and 610 other files + and 607 other files Gergely Nagy: changed erc.el @@ -1857,9 +1868,9 @@ Giuseppe Scrivano: changed browse-url.el buffer.c configure.ac sysdep.c Glenn Morris: wrote check-declare.el f90-tests.el vc-bzr-tests.el and changed configure.ac Makefile.in src/Makefile.in calendar.el diary-lib.el lisp/Makefile.in files.el make-dist rmail.el - progmodes/f90.el bytecomp.el simple.el authors.el admin.el startup.el + progmodes/f90.el bytecomp.el simple.el admin.el authors.el startup.el emacs.texi misc/Makefile.in display.texi lib-src/Makefile.in ack.texi - subr.el and 1760 other files + subr.el and 1761 other files Glynn Clements: wrote gamegrid.el snake.el tetris.el @@ -1901,11 +1912,13 @@ Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c Gregory Chernov: changed nnslashdot.el +Gregory Heytings: changed minibuffer.el + Grégory Mounié: changed display.texi hi-lock.el man.el xfns.c Gregory Neil Shapiro: changed mailabbrev.el -Gregor Zattler: changed eshell.texi emacs-lisp-intro.texi +Gregor Zattler: changed eshell.texi eww.texi emacs-lisp-intro.texi Greg Stark: changed gnus-ems.el timezone.el @@ -1957,7 +1970,7 @@ Harald Maier: changed w32heap.c Harald Meland: changed gnus-art.el gnus-salt.el gnus-score.el gnus-util.el gnus-win.el mail-source.el -Harri Kiiskinen: changed org-protocol.el ox-publish.el +Harri Kiiskinen: changed org-protocol.el org-publish.el H. Dieter Wilhelm: changed calc-help.el maintaining.texi @@ -2004,7 +2017,7 @@ Hong Xu: changed etags.el simple.el maintaining.texi minibuf.texi paren.el progmodes/python.el search.c editfns.c em-cmpl.el emacs-mime.texi files.texi flyspell.el gnus-cite.el message.el parse-time-tests.el parse-time.el progmodes/cpp.el programs.texi - python-tests.el subr.el url-util.el and 3 other files + python-tests.el subr.el tramp.texi and 4 other files Hosoya Kei: changed TUTORIAL.ja @@ -2099,7 +2112,8 @@ Istvan Marko: changed gnus-agent.el xfns.c Itai Zukerman: changed mm-decode.el Ivan Andrus: changed editfns.c epg.el ffap.el find-file.el ibuf-ext.el - ibuffer.el newcomment.el nxml-mode.el progmodes/python.el + ibuffer.el newcomment.el nextstep/templates/Info.plist.in nxml-mode.el + progmodes/python.el Ivan Boldyrev: changed mml1991.el @@ -2155,7 +2169,7 @@ J. Alexander Branham: wrote conf-mode-tests.el Jambunathan K: wrote ox-odt.el and co-wrote ox-html.el -and changed org-lparse.el org.el org.texi ox.el icomplete.el +and changed org-lparse.el org.el org-exp.el org.texi icomplete.el OrgOdtContentTemplate.xml OrgOdtStyles.xml hi-lock.el replace.el minibuffer.el org-footnote.el org-inlinetask.el register.el doc-view.el etags.el htmlfontify.el ido.el indian.el iswitchb.el org-bbdb.el @@ -2216,14 +2230,14 @@ Jan Rychter: changed gnus-msg.el Jan Schormann: wrote solitaire.el -Jan Seeger: changed ox-publish.el parse-time.el +Jan Seeger: changed org-publish.el parse-time.el Jan Tatarik: wrote gnus-icalendar.el and changed gnus-score.el gnus-logic.el Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el -Jared Finder: changed progmodes/compile.el +Jared Finder: changed commands.texi progmodes/compile.el Jarek Czekalski: changed keyboard.c callproc.c mini.texi minibuf.c misc.texi server.el shell.el w32fns.c xgselect.c @@ -2249,7 +2263,7 @@ Jason Dunsmore: changed org.el ox-html.el Jason L. Wright: changed smtpmail.el -Jason Merrill: changed gnus-sum.el add-log.el gnus-salt.el imap.el +Jason Merrill: changed gnus-sum.el add-log.el gnus-salt.el net/imap.el nnfolder.el Jason Riedy: changed org-table.el org.texi @@ -2572,7 +2586,7 @@ John Williams: changed bytecomp-tests.el etags.el John Yates: changed hideshow.el -Jon Anders Skorpen: changed ox-publish.el +Jon Anders Skorpen: changed org-publish.el Jonas Bernoulli: changed eieio.el button.el cus-edit.el ido.el lisp-mnt.el tabulated-list.el tips.texi @@ -2634,7 +2648,7 @@ and changed erc.el erc-track.el erc-backend.el erc-match.el misc.el Jose A. Ortega Ruiz: changed gnus-sum.el url-http.el -Jose E. Marchesi: changed ada-mode.el gomoku.el simple.el smtpmail.el +Jose E. Marchesi: changed gomoku.el simple.el smtpmail.el José L. Doménech: changed dired-aux.el @@ -2674,12 +2688,12 @@ Juanma Barranquero: wrote emacs-lock.el frameset.el help-tests.el and changed subr.el desktop.el w32fns.c faces.el simple.el emacsclient.c files.el server.el bs.el help-fns.el xdisp.c org.el w32term.c w32.c buffer.c keyboard.c ido.el image.c window.c eval.c allout.el - and 1235 other files + and 1234 other files Juan Pechiar: wrote ob-mscgen.el and changed ob-octave.el -Juergen Kreileder: changed imap.el nnimap.el +Juergen Kreileder: changed net/imap.el nnimap.el Juergen Nickelsen: wrote ws-mode.el @@ -2718,7 +2732,7 @@ and changed tramp-gvfs.el tramp-sh.el comint.el em-unix.el esh-util.el Juri Linkov: wrote files-x.el misearch.el replace-tests.el tab-bar.el tab-line.el and changed isearch.el info.el simple.el replace.el dired.el dired-aux.el - progmodes/grep.el image-mode.el progmodes/compile.el startup.el subr.el + progmodes/grep.el image-mode.el progmodes/compile.el subr.el startup.el diff-mode.el files.el menu-bar.el faces.el display.texi bindings.el desktop.el comint.el minibuffer.el search.texi and 419 other files @@ -2744,12 +2758,12 @@ and co-wrote longlines.el tramp-sh.el tramp.el and changed message.el gnus-agent.el gnus-sum.el files.el nnmail.el tramp.texi nntp.el gnus.el simple.el ange-ftp.el dired.el paragraphs.el bindings.el files.texi gnus-art.el gnus-group.el man.el INSTALL - Makefile.in crisp.el fileio.c and 44 other files + Makefile.in crisp.el fileio.c and 45 other files Kailash C. Chowksey: changed HELLO ind-util.el kannada.el knd-util.el lisp/Makefile.in loadup.el -Kai Tetzlaff: changed ox-publish.el url-http.el +Kai Tetzlaff: changed org-publish.el url-http.el Kalle Kankare: changed image.c @@ -2786,7 +2800,7 @@ and changed simple.el files.el doc-view.el image-mode.el info.el Karl Heuer: changed keyboard.c lisp.h xdisp.c buffer.c xfns.c xterm.c alloc.c files.el frame.c configure.ac window.c data.c minibuf.c editfns.c fns.c process.c Makefile.in fileio.c simple.el keymap.c - indent.c and 446 other files + indent.c and 447 other files Karl Kleinpaste: changed gnus-sum.el gnus-art.el gnus-picon.el gnus-score.el gnus-uu.el gnus-xmas.el gnus.el mm-uu.el mml.el nnmail.el @@ -2814,7 +2828,7 @@ Katsumi Yamaoka: wrote canlock.el and changed gnus-art.el gnus-sum.el message.el mm-decode.el gnus.texi mm-util.el mm-view.el gnus-group.el gnus-util.el gnus-msg.el mml.el shr.el rfc2047.el gnus-start.el gnus.el nntp.el gnus-agent.el nnrss.el - mm-uu.el nnmail.el emacs-mime.texi and 161 other files + mm-uu.el nnmail.el emacs-mime.texi and 165 other files Kaushal Modi: changed files.el isearch.el apropos.el calc-yank.el custom.texi desktop.el ediff-diff.el eww.el ffap.el maintaining.texi @@ -2827,8 +2841,8 @@ Kaveh R. Ghazi: changed delta88k.h xterm.c Kayvan Sylvan: changed supercite.el -Kazuhiro Ito: changed coding.c flow-fill.el font.c keyboard.c - make-mode.el net/starttls.el xdisp.c +Kazuhiro Ito: changed coding.c font.c keyboard.c mail/flow-fill.el + make-mode.el net/starttls.el uudecode.el xdisp.c Kazushi Marukawa: changed filelock.c hexl.c profile.c unexalpha.c @@ -2942,12 +2956,12 @@ Kim F. Storm: wrote bindat.el cua-base.el cua-gmrk.el cua-rect.el ido.el and changed xdisp.c dispextern.h process.c simple.el window.c keyboard.c xterm.c dispnew.c subr.el w32term.c lisp.h fringe.c display.texi macterm.c alloc.c fns.c xfaces.c keymap.c xfns.c xterm.h .gdbinit - and 249 other files + and 248 other files Kimit Yada: changed copyright.el Kim-Minh Kaplan: changed gnus-picon.el gnus-sum.el gnus-start.el - gnus-win.el gnus-xmas.el gnus.texi imap.el message.el nndraft.el + gnus-win.el gnus-xmas.el gnus.texi message.el net/imap.el nndraft.el nnml.el Kirill A. Korinskiy: changed fortune.el @@ -2978,11 +2992,11 @@ Koichi Arakawa: changed tramp-sh.el w32proc.c Konrad Hinsen: wrote ol-eshell.el and changed ob-python.el -Konstantin Kharlamov: changed ada-mode.el calc-aent.el calc-ext.el - calc-lang.el cc-mode.el cperl-mode.el css-mode.el cua-rect.el - diff-mode.el dnd.el ebnf-abn.el ebnf-dtd.el ebnf-ebx.el - emacs-module-tests.el epg.el faces.el gnus-art.el gtkutil.c hideif.el - htmlfontify.el lex.el and 24 other files +Konstantin Kharlamov: changed calc-aent.el calc-ext.el calc-lang.el + cc-mode.el cperl-mode.el css-mode.el cua-rect.el diff-mode.el dnd.el + ebnf-abn.el ebnf-dtd.el ebnf-ebx.el emacs-module-tests.el epg.el + faces.el gnus-art.el gtkutil.c hideif.el htmlfontify.el lex.el mapconv + and 23 other files Konstantin Kliakhandler: changed org-agenda.el @@ -3062,7 +3076,7 @@ and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el and changed gnus.texi process.c subr.el simple.el files.el gnutls.c gnus-ems.el smtpmail.el display.texi url-http.el auth-source.el gnus-cite.el pop3.el dired.el edebug.el gnus-xmas.el text.texi image.el - image.c gnutls.el nnrss.el and 651 other files + image.c gnutls.el nnrss.el and 658 other files Lars Rasmusson: changed ebrowse.c @@ -3071,10 +3085,11 @@ Lasse Rasinen: changed gnus-start.el Laurent Martelli: changed mm-decode.el Lawrence Mitchell: wrote erc-backend.el erc-log.el -and changed erc.el ox-latex.el org.el ox.el erc-match.el erc-nets.el - erc-nickserv.el ox-html.el browse-url.el erc-button.el erc-compat.el - erc-dcc.el erc-fill.el erc-list.el erc-track.el ielm.el ob.el Makefile - cl-macs.el erc-autoaway.el erc-autojoin.el and 25 other files +and changed erc.el ox-latex.el org.el erc-match.el erc-nets.el + erc-nickserv.el org-exp.el ox-html.el browse-url.el erc-button.el + erc-compat.el erc-dcc.el erc-fill.el erc-list.el erc-track.el ielm.el + ob.el Makefile cl-macs.el erc-autoaway.el erc-autojoin.el + and 26 other files Lawrence R. Dodd: co-wrote dired-x.el and changed fortran.el ispell.el sendmail.el cmuscheme.el comint.el @@ -3092,11 +3107,11 @@ Lele Gaifax: changed progmodes/python.el flymake.el python-tests.el TUTORIAL.it flymake-proc.el flymake.texi isearch.el Lennart Borgman: co-wrote ert-x.el -and changed nxml-mode.el tutorial.el re-builder.el window.el ada-xref.el - buff-menu.el emacs-lisp/debug.el emacsclient.c filesets.el flymake.el - help-fns.el isearch.el linum.el lisp-mode.el lisp.el mouse.el - recentf.el remember.el replace.el ruby-mode.el shell.el - and 4 other files +and changed nxml-mode.el tutorial.el re-builder.el window.el buff-menu.el + emacs-lisp/debug.el emacsclient.c filesets.el flymake.el help-fns.el + isearch.el linum.el lisp-mode.el lisp.el mouse.el recentf.el + remember.el replace.el ruby-mode.el shell.el texinfmt.el + and 3 other files Lennart Staflin: changed dired.el diary-ins.el diary-lib.el tq.el xdisp.c @@ -3148,7 +3163,7 @@ Luc Teirlinck: wrote help-at-pt.el and changed files.el autorevert.el cus-edit.el subr.el simple.el frames.texi startup.el display.texi files.texi dired.el comint.el modes.texi custom.texi emacs.texi fns.c frame.el ielm.el minibuf.texi - variables.texi buffers.texi commands.texi and 211 other files + variables.texi buffers.texi commands.texi and 212 other files Ludovic Courtès: wrote nnregistry.el and changed configure.ac gnus.texi loadup.el @@ -3165,8 +3180,8 @@ Lukas Huonker: changed tetris.el auth-source-pass.el Łukasz Stelmach: changed erc.el ps-print.el cookie1.el gnus-group.el - gtkutil.c message.el org-agenda.el org-bbdb.el org.el org.texi - ox-html.el ox.el simple.el + gtkutil.c message.el org-agenda.el org-bbdb.el org-exp.el org.el + org.texi ox-html.el simple.el Luke Lee: changed hideif.el @@ -3176,7 +3191,7 @@ Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el generic.el font-lock.el simple.el subr.el battery.el debugging.texi easy-mmode.el elisp.texi emacs-lisp/generic.el hl-line.el info.el octave.el basic.texi bindings.el calc.el cmdargs.texi diff-mode.el - doclicense.texi and 290 other files + doclicense.texi and 289 other files Lynn Slater: wrote help-macro.el @@ -3197,7 +3212,7 @@ Malcolm Purvis: changed spam-stat.el Manoj Srivastava: wrote manoj-dark-theme.el -Manuel Giraud: changed ox-html.el ox-publish.el org.texi +Manuel Giraud: changed ox-html.el org-publish.el org.texi Manuel Gómez: changed speedbar.el @@ -3297,7 +3312,7 @@ and changed image-dired.el dunnet.el mpc.el eww.el json.el calc-units.el Mark Plaksin: changed nnrss.el term.el -Mark Thomas: changed flow-fill.el gnus-sum.el gnus-util.el nnmail.el +Mark Thomas: changed gnus-sum.el gnus-util.el mail/flow-fill.el nnmail.el Mark Triggs: changed nnir.el @@ -3316,7 +3331,7 @@ and changed cus-edit.el files.el progmodes/compile.el rmail.el tex-mode.el find-func.el rmailsum.el simple.el cus-dep.el dired.el mule-cmds.el rmailout.el checkdoc.el configure.ac custom.el emacsbug.el gnus.el help-fns.el ls-lisp.el mwheel.el sendmail.el - and 126 other files + and 125 other files Markus Sauermann: changed lisp-mode.el @@ -3359,7 +3374,7 @@ Martin Pohlack: changed iimage.el pc-select.el Martin Rudalics: changed window.el window.c windows.texi frame.c xdisp.c w32fns.c xterm.c frames.texi w32term.c xfns.c frame.el display.texi help.el buffer.c window.h cus-start.el frame.h dispnew.c mouse.el - nsfns.m gtkutil.c and 209 other files + nsfns.m gtkutil.c and 208 other files Martin Stjernholm: wrote cc-bytecomp.el and co-wrote cc-align.el cc-cmds.el cc-compat.el cc-defs.el cc-engine.el @@ -3378,7 +3393,7 @@ and changed ob-emacs-lisp.el Masahiko Sato: wrote vip.el -Masahiro Nakamura: changed ns-win.el nsterm.m +Masahiro Nakamura: changed ns-win.el nsterm.m w32fns.c Masanobu Umeda: wrote metamail.el rmailsort.el timezone.el and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus.el nnbabyl.el @@ -3410,7 +3425,8 @@ Mathieu Othacehe: changed tramp-adb.el Mats Lidell: changed TUTORIAL.sv european.el gnus-art.el org-element.el -Matt Armstrong: changed gnus-topic.el gnus.el imap.el message.el shell.el +Matt Armstrong: changed gnus-topic.el gnus.el message.el net/imap.el + shell.el Matt Bisson: changed xterm.c @@ -3460,8 +3476,8 @@ Matt Hodges: changed textmodes/table.el faces.el iswitchb.el simple.el Mattias Engdegård: changed rx.el searching.texi rx-tests.el autorevert.el calc-tests.el regexp-opt.el filenotify.el subr.el files.el - progmodes/compile.el mouse.el bytecomp.el compile-tests.el - autorevert-tests.el byte-opt.el bytecomp-tests.el calc-alg.el + progmodes/compile.el bytecomp.el mouse.el bytecomp-tests.el + compile-tests.el autorevert-tests.el byte-opt.el calc-alg.el compilation.txt dired.el font.c regex-emacs.c and 170 other files Matt Lundin: changed org-agenda.el org.el org-bibtex.el org-footnote.el @@ -3480,7 +3496,7 @@ Mauro Aranda: changed wid-edit.el cus-edit.el gnus.texi octave.el pong.el autorevert.el cc-mode.texi control.texi custom-tests.el custom.el dbus.texi dired-x.texi elisp-mode.el epa.el esh-mode.el eshell/eshell.el eudc.texi files.texi functions.texi gnus-faq.texi - info.el and 14 other files + info.el and 15 other files Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el @@ -3500,7 +3516,7 @@ and co-wrote tramp-cache.el tramp-sh.el tramp.el and changed tramp.texi tramp-adb.el trampver.el trampver.texi dbusbind.c file-notify-tests.el files.el ange-ftp.el files.texi dbus.texi autorevert.el tramp-fish.el kqueue.c tramp-gw.el tramp-imap.el os.texi - xesam.el configure.ac lisp.h shell.el gfilenotify.c and 254 other files + xesam.el configure.ac lisp.h shell.el gfilenotify.c and 256 other files Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h unexec.c @@ -3573,7 +3589,7 @@ Michael Olson: changed erc.el erc-backend.el Makefile erc-track.el erc-log.el erc-stamp.el erc-autoaway.el erc-dcc.el erc-goodies.el erc-list.el erc-compat.el erc-identd.el erc.texi ERC-NEWS erc-bbdb.el erc-match.el erc-notify.el erc-ibuffer.el erc-services.el remember.el - erc-button.el and 54 other files + erc-button.el and 55 other files Michael Orlitzky: changed tex-mode.el @@ -3695,7 +3711,7 @@ Miles Bader: wrote button.el face-remap.el image-file.el macroexp.el and changed comint.el faces.el simple.el editfns.c xfaces.c xdisp.c info.el minibuf.c display.texi quick-install-emacs wid-edit.el xterm.c dispextern.h subr.el window.el cus-edit.el diff-mode.el xfns.c - bytecomp.el help.el lisp.h and 272 other files + bytecomp.el help.el lisp.h and 271 other files Milton Wulei: changed gdb-ui.el @@ -3737,7 +3753,7 @@ Myles English: changed org-clock.el Nachum Dershowitz: co-wrote cal-hebrew.el Nagy Andras: co-wrote gnus-sieve.el -and changed imap.el gnus.el +and changed net/imap.el gnus.el Nakagawa Makoto: changed ldap.el @@ -3791,7 +3807,7 @@ Nick Alcock: changed control.texi customize.texi display.texi files.el frames.texi gnus.el keymaps.texi modes.texi nonascii.texi syntax.texi text.texi windows.texi -Nick Dokos: changed org-table.el ox.el icalendar.el mh-search.el +Nick Dokos: changed org-exp.el org-table.el icalendar.el mh-search.el org-mobile.el org.el ox-ascii.el url-cache.el Nick Drozd: changed quail/georgian.el eww.el eww.texi shr.el HELLO @@ -3819,10 +3835,10 @@ Nicolas Goaziou: wrote org-duration.el org-element.el org-keys.el ox-org.el ox.el and co-wrote ox-beamer.el ox-icalendar.el ox-man.el and changed org-list.el org.el ox-html.el org-footnote.el ox-texinfo.el - org.texi ox-publish.el ox-odt.el org-inlinetask.el org-indent.el - org-docbook.el ob-exp.el org-agenda.el org-timer.el ob.el + org-exp.el org.texi ox-publish.el ox-odt.el org-inlinetask.el + org-indent.el org-docbook.el ob-exp.el org-agenda.el org-timer.el ob.el org-capture.el ob-asymptote.el org-clock.el org-macs.el - org-pcomplete.el org-table.el and 22 other files + org-pcomplete.el and 25 other files Nicolas Graner: changed message.el @@ -3872,7 +3888,7 @@ and co-wrote erc-dcc.el and changed rsz-mini.el emacs-buffer.gdb comint.el files.el Makefile mailabbrev.el sendmail.el subr.el timer.el xfns.c yow.el apropos.el battery.el bytecomp.el calc.el coding.c complete.el config.in - configure.ac copyright.h fns.c and 22 other files + configure.ac copyright.h fns.c and 23 other files Noah Lavine: changed tramp.el @@ -3901,7 +3917,7 @@ Nozomu Ando: changed unexmacosx.c alloc.c buffer.c mips.h pmax.h N. Raghavendra: changed timezone.el -Nuutti Kotivuori: changed gnus-sum.el flow-fill.el gnus-cache.el +Nuutti Kotivuori: changed gnus-sum.el gnus-cache.el mail/flow-fill.el Odd Gripenstam: wrote dcl-mode.el @@ -3972,6 +3988,8 @@ and changed ph.el Øyvind Stegard: changed gnus-msg.el +Pankaj Jangid: changed semantic.texi + Pascal Dupuis: changed octave.el Pascal Rigaux: changed image.c rfc2231.el @@ -3992,7 +4010,7 @@ and co-wrote cal-dst.el and changed lisp.h configure.ac alloc.c process.c fileio.c editfns.c xdisp.c sysdep.c image.c keyboard.c emacs.c data.c fns.c lread.c xterm.c eval.c callproc.c Makefile.in frame.c buffer.c gnulib-comp.m4 - and 1822 other files + and 1820 other files Paul Fisher: changed fns.c @@ -4018,7 +4036,7 @@ Paul Reilly: changed dgux.h lwlib-Xm.c lwlib.c xlwmenu.c configure.ac lwlib/Makefile.in mail/rmailmm.el rmailedit.el rmailkwd.el and 10 other files -Paul Rivier: changed ada-mode.el mixal-mode.el reftex-vars.el reftex.el +Paul Rivier: changed mixal-mode.el reftex-vars.el reftex.el Paul Rubin: changed config.h sun2.h texinfmt.el window.c @@ -4037,7 +4055,7 @@ Pavel Janík: co-wrote eudc-bob.el eudc-export.el eudc-hotlist.el and changed keyboard.c xterm.c COPYING xdisp.c process.c emacs.c lisp.h menu-bar.el ldap.el make-dist xfns.c buffer.c coding.c eval.c fileio.c flyspell.el fns.c indent.c Makefile.in callint.c cus-start.el - and 702 other files + and 699 other files Pavel Kobiakov: wrote flymake-proc.el flymake.el and changed flymake.texi @@ -4175,13 +4193,13 @@ Philipp Rumpf: changed electric.el Philipp Stephani: wrote callint-tests.el checkdoc-tests.el cl-preloaded-tests.el ediff-diff-tests.el eval-tests.el ido-tests.el lread-tests.el mouse-tests.el startup-tests.el xt-mouse-tests.el -and changed emacs-module.c emacs-module-tests.el json.c json-tests.el - mod-test.c eval.c lisp.h lread.c nsterm.m configure.ac bytecomp.el +and changed emacs-module.c emacs-module-tests.el json.c mod-test.c + json-tests.el eval.c lisp.h lread.c nsterm.m configure.ac bytecomp.el internals.texi gtkutil.c emacs-module.h.in files.el alloc.c editfns.c electric-tests.el electric.el test/Makefile.in emacs.c and 129 other files -Phillip Lord: wrote ps-print-tests.el +Phillip Lord: wrote ps-print-tests.el w32-feature.el and changed build-zips.sh lisp/Makefile.in build-dep-zips.py undo.c simple.el test/Makefile.in Makefile Makefile.in emacs.nsi keyboard.c viper-cmd.el README-windows-binaries README.W32 elisp-mode-tests.el @@ -4191,7 +4209,7 @@ and changed build-zips.sh lisp/Makefile.in build-dep-zips.py undo.c Phil Sainty: wrote autoload-longlines-mode-tests.el autoload-major-mode-tests.el autoload-minor-mode-tests.el so-long-tests-helpers.el so-long-tests.el so-long.el spelling-tests.el -and changed diff.el goto-addr.el term.el cl-macs.el comint.el derived.el +and changed comint.el diff.el goto-addr.el term.el cl-macs.el derived.el easy-mmode.el emacs.texi files.texi lisp.el misc.texi package.el progmodes/grep.el simple.el subword.el trouble.texi @@ -4223,9 +4241,9 @@ Piotr Trojanek: changed gnutls.c process.c Piotr Zieliński: wrote org-mouse.el Pip Cet: changed fns.c display.texi xdisp.c xterm.c composite.c - dispextern.h frame.el gtkutil.c image.c indent.c json-tests.el json.c - mail-utils.el nsterm.m simple.el subr.el text.texi textprop.c - timer-list.el tty-colors-tests.el tty-colors.el and 4 other files + dispextern.h frame.el ftcrfont.c gtkutil.c image.c indent.c + json-tests.el json.c mail-utils.el nsterm.m simple.el subr.el text.texi + textprop.c timer-list.el tty-colors-tests.el and 5 other files Pontus Michael: changed simple.el @@ -4237,8 +4255,10 @@ Przemysław Wojnowski: wrote obarray-tests.el sgml-mode-tests.el and changed abbrev-tests.el abbrev.el cl-lib-tests.el loadup.el obarray.el sgml-mode.el -Puneeth Chaganti: changed org.texi ox.el org-agenda.el org-capture.el - ox-html.el svg.el +Puneeth Chaganti: changed org.texi org-exp.el org-agenda.el + org-capture.el ox-html.el svg.el + +Qiantan Hong: changed xwidget.c Radon Rosborough: changed package.el custom.texi package.texi startup.el eval.c lread.c org.texi os.texi @@ -4270,7 +4290,7 @@ Ralf Angeli: wrote scroll-lock.el and changed w32fns.c reftex-cite.el gnus-art.el reftex-toc.el reftex.el reftex-auc.el reftex-dcr.el reftex-global.el reftex-index.el reftex-parse.el reftex-ref.el reftex-sel.el reftex-vars.el reftex.texi - tex-mode.el comint.el flow-fill.el frame.el killing.texi mm-uu.el + tex-mode.el comint.el frame.el killing.texi mail/flow-fill.el mm-uu.el mm-view.el and 6 other files Ralf Fassel: changed dabbrev.el files.el fill.el iso-acc.el tar-mode.el @@ -4311,7 +4331,7 @@ Reiner Steib: wrote gmm-utils.el and changed message.el gnus.texi gnus-art.el gnus-sum.el gnus-group.el gnus.el mml.el gnus-faq.texi mm-util.el gnus-score.el message.texi gnus-msg.el gnus-start.el gnus-util.el spam-report.el mm-uu.el spam.el - mm-decode.el files.el gnus-agent.el nnmail.el and 172 other files + mm-decode.el files.el gnus-agent.el nnmail.el and 173 other files Remek Trzaska: changed gnus-ems.el @@ -4329,9 +4349,8 @@ and changed vhdl-mode.texi Reuben Thomas: changed ispell.el whitespace.el dired-x.el files.el sh-script.el emacsclient-tests.el remember.el README emacsclient.c - misc.texi msdos.c simple.el INSTALL ada-mode.el ada-xref.el alloc.c - arc-mode.el authors.el config.bat copyright dired-x.texi - and 36 other files + misc.texi msdos.c simple.el INSTALL alloc.c arc-mode.el authors.el + config.bat copyright dired-x.texi dired.el dosfns.c and 34 other files Ricardo Wurmus: changed xwidget.el xwidget.c configure.ac xwidget.h @@ -4374,7 +4393,7 @@ and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-langs.el and changed files.el keyboard.c simple.el xterm.c xdisp.c rmail.el fileio.c process.c sysdep.c buffer.c xfns.c window.c subr.el configure.ac startup.el sendmail.el emacs.c Makefile.in editfns.c - info.el dired.el and 1338 other files + info.el dired.el and 1337 other files Richard Ryniker: changed sendmail.el @@ -4425,7 +4444,7 @@ and changed process.c ftfont.c gtkutil.c processes.texi vc-git.el configure.ac font.c network-stream.el nsm.el process-tests.el xfns.c custom.texi dispextern.h files.texi ftcrfont.c gnus-icalendar.el gnutls.el gtkutil.h network-stream-tests.el nsterm.m text.texi - and 92 other files + and 94 other files Robert Thorpe: changed cus-start.el indent.el @@ -4450,7 +4469,7 @@ Roger Breitenstein: changed smtpmail.el Roland B. Roberts: changed buffer.h callproc.c dired.c files.el gnus-group.el gnus-sum.el process.c sort.el sysdep.c systty.h -Roland Kaufmann: changed ox.el +Roland Kaufmann: changed org-exp.el Roland McGrath: wrote autoload.el etags.el map-ynp.el progmodes/grep.el and co-wrote find-dired.el progmodes/compile.el @@ -4492,9 +4511,9 @@ Roy Liu: changed ns-win.el Rüdiger Sonderfeld: wrote inotify-tests.el reftex-tests.el and changed eww.el octave.el shr.el bibtex.el configure.ac - misc/Makefile.in reftex-vars.el vc-git.el TUTORIAL.de ada-mode.el - autoinsert.el building.texi calc-lang.el cc-langs.el dired.texi - editfns.c emacs.c emacs.texi epa.el erc.el eww.texi and 39 other files + misc/Makefile.in reftex-vars.el vc-git.el TUTORIAL.de autoinsert.el + building.texi calc-lang.el cc-langs.el dired.texi editfns.c emacs.c + emacs.texi epa.el erc.el eww.texi ffap.el and 38 other files Rui-Tao Dong: changed nnweb.el @@ -4548,7 +4567,7 @@ and changed progmodes/compile.el cl-indent.el simple.el vc-cvs.el vc.el mouse.el vc-hg.el etags.el files.el font-lock.el tex-mode.el ange-ftp.el sgml-mode.el vc-git.el window.el add-log.el bindings.el bookmark.el bug-reference.el calendar.el cperl-mode.el - and 157 other files + and 155 other files Samuel Bronson: changed custom.el emacsclient.c keyboard.c progmodes/grep.el semantic/format.el unexmacosx.c @@ -4625,7 +4644,7 @@ and changed add-log.el Sebastian Reuße: changed find-dired.el Sebastian Rose: co-wrote org-protocol.el -and changed ox-publish.el ftfont.c ox-jsinfo.el +and changed org-publish.el ftfont.c org-jsinfo.el Sebastian Tennant: changed desktop.el @@ -4642,8 +4661,9 @@ Sébastien Vauban: changed org.el org-agenda.el ox-latex.el ob-core.el org-clock.el ox-ascii.el ox-html.el Seiji Zenitani: changed nsfns.m frame.c xterm.c PkgInfo document.icns - find-func.el frame.h help-fns.el macfns.c nsfont.m nsterm.m w32fns.c - xdisp.c xfns.c + find-func.el frame.h help-fns.el macfns.c + nextstep/templates/Info.plist.in nsfont.m nsterm.m w32fns.c xdisp.c + xfns.c Sen Nagata: wrote crm.el rfc2368.el @@ -4653,6 +4673,8 @@ Seppo Sade: changed esh-ext.el Sergei Organov: changed vc.el +Serge Tupchii: changed etags.c + Sergey Litvinov: co-wrote ob-fortran.el and changed ob-maxima.el ob-octave.el @@ -4688,7 +4710,7 @@ and changed gnus-art.el message.el gnus-sum.el gnus-msg.el gnus.el gnus-agent.el mm-decode.el mm-util.el gnus-group.el mml.el gnus-start.el gnus-util.el mm-view.el nnslashdot.el nnmail.el nntp.el gnus-topic.el gnus-xmas.el rfc2047.el mail-source.el gnus-win.el - and 93 other files + and 95 other files Shigeru Fukaya: wrote bytecomp-tests.el and changed apropos.el bs.el byte-opt.el bytecomp.el elint.el rx-new.el @@ -4732,11 +4754,11 @@ Simon Josefsson: wrote dig.el dns-mode.el flow-fill.el fringe.el imap.el sieve.el smime.el starttls.el tls.el url-imap.el and co-wrote gnus-sieve.el gssapi.el mml1991.el nnfolder.el nnimap.el nnml.el sieve-manage.el -and changed message.el gnus-sum.el gnus-art.el smtpmail.el pgg-gpg.el - pgg.el gnus-agent.el mml2015.el mml.el gnus-group.el mm-decode.el - gnus-msg.el gnus.texi mail/sieve-manage.el pgg-pgp5.el browse-url.el - gnus-int.el gnus.el hashcash.el mm-view.el password.el - and 101 other files +and changed message.el gnus-sum.el net/imap.el gnus-art.el smtpmail.el + pgg-gpg.el pgg.el gnus-agent.el mml2015.el mml.el gnus-group.el + mm-decode.el gnus-msg.el gnus.texi mail/sieve-manage.el pgg-pgp5.el + browse-url.el gnus-int.el gnus.el hashcash.el mail/flow-fill.el + and 103 other files Simon Lang: changed misterioso-theme.el @@ -4783,9 +4805,10 @@ Stefan Kangas: wrote bookmark-tests.el delim-col-tests.el morse-tests.el paragraphs-tests.el password-cache-tests.el studly-tests.el tabify-tests.el timezone-tests.el underline-tests.el uudecode-tests.el and changed bookmark.el package.el efaq.texi package.texi ibuffer.el - mwheel.el cperl-mode.el fns.c gud.el simple.el subr.el autoinsert.el - comint-tests.el control.texi cus-edit.el delim-col.el dired-aux.el - dired-x.el em-term.el ert.texi flow-fill.el and 153 other files + mwheel.el cperl-mode.el fns.c gud.el simple.el subr.el tips.texi + autoinsert.el comint-tests.el control.texi cus-edit.el delim-col.el + dired-aux.el dired-x.el em-term.el emacs-lisp-intro.texi + and 157 other files Stefan Merten: co-wrote rst.el @@ -4801,7 +4824,7 @@ and co-wrote font-lock.el gitmerge.el pcvs.el and changed subr.el simple.el keyboard.c bytecomp.el files.el lisp.h cl-macs.el vc.el xdisp.c alloc.c eval.c sh-script.el progmodes/compile.el keymap.c tex-mode.el buffer.c newcomment.el - window.c lread.c fileio.c help-fns.el and 1373 other files + window.c lread.c fileio.c help-fns.el and 1377 other files Stefano Facchini: changed gtkutil.c @@ -4817,7 +4840,7 @@ Stefan-W. Hahn: changed org-bibtex.el ps-print.el simple.el subr.el Stefan Wiens: changed gnus-sum.el -Steinar Bang: changed gnus-setup.el imap.el +Steinar Bang: changed gnus-setup.el net/imap.el Štěpán Němec: changed INSTALL calc-ext.el checkdoc.el cl.texi comint.el edebug.texi font-lock.el functions.texi gnus-sum.el gnus.texi insdel.c @@ -4835,7 +4858,7 @@ and changed wdired.el todo-mode.texi diary-lib.el wdired-tests.el dired-tests.el doc-view.el files.el minibuffer.el dired.el frames.texi hl-line.el info.el menu-bar.el mouse.el otodo-mode.el subr.el .gitattributes TUTORIAL allout.el artist.el compile.texi - and 44 other files + and 46 other files Stephen C. Gilardi: changed configure.ac @@ -4857,11 +4880,11 @@ and changed time-stamp.el time-stamp-tests.el mh-e.el mh-comp.el Stephen J. Turnbull: changed ediff-init.el strings.texi subr.el Stephen Leake: wrote elisp-mode-tests.el -and changed ada-mode.el ada-xref.el elisp-mode.el xref.el window.el - mode-local.el CONTRIBUTE ada-prj.el project.el vc-mtn.el ada-stmt.el - cedet-global.el ede/generic.el simple.el autoload.el bytecomp.el - cl-generic.el ede/locate.el files.texi functions.texi package.el - and 30 other files +and changed elisp-mode.el xref.el window.el mode-local.el CONTRIBUTE + project.el vc-mtn.el ada-stmt.el cedet-global.el ede/generic.el + simple.el autoload.el bytecomp.el cl-generic.el ede/locate.el + files.texi functions.texi package.el progmodes/grep.el windows.texi + INSTALL.REPO and 27 other files Stephen Pegoraro: changed xterm.c @@ -4932,7 +4955,8 @@ Sun Yijiang: changed TUTORIAL.cn Susanne Oberhauser: changed hideshow.el -Suvayu Ali: changed org.texi org-inlinetask.el org-src.el org.el ox.el +Suvayu Ali: changed org.texi org-exp.el org-inlinetask.el org-src.el + org.el Svante Carl V. Erichsen: changed cl-indent.el @@ -5007,7 +5031,7 @@ Teodor Zlatanov: wrote auth-source.el gnus-registry.el gnus-tests.el and changed spam.el gnus.el nnimap.el gnus.texi gnutls.c gnus-sum.el auth.texi cfengine.el gnus-sync.el gnus-util.el gnus-start.el netrc.el gnutls.h message.el spam-stat.el encrypt.el mail-source.el nnir.el - nnmail.el auth-source-tests.el configure.ac and 119 other files + nnmail.el auth-source-tests.el configure.ac and 120 other files Terje Rosten: changed xfns.c version.el xterm.c xterm.h @@ -5020,7 +5044,7 @@ Tetsuo Tsukamoto: changed nnrss.el Tetsurou Okazaki: changed Makefile.in byte-opt.el lib-src/Makefile.in log-edit.el lread.c xterm.c -T.F. Torrey: changed org-rmail.el ox.el +T.F. Torrey: changed org-exp.el org-rmail.el Thamer Mahmoud: changed arabic.el @@ -5037,7 +5061,7 @@ and co-wrote hideshow.el and changed ewoc.el vc.el info.el processes.texi zone.el lisp-mode.el scheme.el text.texi vc-rcs.el display.texi fileio.c files.el vc-git.el TUTORIAL.it bindat.el cc-vars.el configure.ac dcl-mode.el diff-mode.el - dired.el elisp.texi and 168 other files + dired.el elisp.texi and 167 other files Thierry Banel: co-wrote ob-C.el and changed calc-arith.el @@ -5231,6 +5255,8 @@ Toru Tsuneyoshi: changed ange-ftp.el buff-menu.el cus-start.el fileio.c Toshiaki Nomura: changed uxpds.h +Travis Jeffery: changed nextstep/templates/Info.plist.in + Trent W. Buck: changed rcirc.el remember.el rx.el Trevor Murphy: changed find-dired.el gnus.texi nnimap.el org.el @@ -5512,9 +5538,9 @@ and changed macterm.c macfns.c mac-win.el xterm.c mac.c macterm.h image.c Yann Dirson: changed imenu.el -Yann Hodique: changed ox-publish.el package.el rcirc.el +Yann Hodique: changed org-publish.el package.el rcirc.el -Yasuhiro Kimura: changed japan-util.el +Yasuhiro Kimura: changed japan-util.el schemas.xml Yasushi Shoji: changed org-clock.el org.texi ox-ascii.el @@ -5548,7 +5574,7 @@ Yu-ji Hosokawa: changed README.W32 Yukihiro Matsumoto: co-wrote ruby-mode.el -Yuri D'elia: changed message.el package.el +Yuri D'Elia: changed message.el package.el Yuri Karaban: changed pop3.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 70bf3f0b347..ecba0f5f41c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -22747,7 +22747,6 @@ Many aspects this mode can be customized using ;;;### (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-"))) @@ -22778,7 +22777,7 @@ Many aspects this mode can be customized using ;;;### (autoloads nil "ob-clojure" "org/ob-clojure.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-clojure.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("org-babel-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("ob-clojure-" "org-babel-"))) ;;;*** @@ -22827,7 +22826,6 @@ 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-"))) @@ -23083,7 +23081,6 @@ Many aspects this mode can be customized using ;;;### (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 1)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-"))) @@ -23196,106 +23193,10 @@ startup file, `~/.emacs-octave'. ;;;*** -;;;### (autoloads nil "ol" "org/ol.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "ol" "org/ol.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/ol.el -(autoload 'org-next-link "ol" "\ -Move forward to the next link. -If the link is in hidden text, expose it. When SEARCH-BACKWARD -is non-nil, move backward. - -\(fn &optional SEARCH-BACKWARD)" t nil) - -(autoload 'org-previous-link "ol" "\ -Move backward to the previous link. -If the link is in hidden text, expose it." t nil) - -(autoload 'org-toggle-link-display "ol" "\ -Toggle the literal or descriptive display of links." t nil) - -(autoload 'org-store-link "ol" "\ -Store a 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' (`\\[org-insert-link]'). - -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 `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not -part of Org core. - -A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the -active region. - -Assume the function is called interactively if INTERACTIVE? is -non-nil. - -\(fn ARG &optional INTERACTIVE\\=\\?)" t nil) - -(autoload 'org-insert-link "ol" "\ -Insert a link. At the prompt, enter the link. - -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. - -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. - -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 a `\\[universal-argument] \\[universal-argument]' prefix, enforce an absolute path even if the file is in -the current directory or below. - -A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix negates `org-link-keep-stored-after-insertion'. - -If the LINK-LOCATION parameter is non-nil, this value will be used as -the link location instead of reading one interactively. - -If the DESCRIPTION parameter is non-nil, this value will be used as the -default description. Otherwise, if `org-link-make-description-function' -is non-nil, this function will be called with the link target, and the -result will be the default link description. When called non-interactively, -don't allow to edit the default description. - -\(fn &optional COMPLETE-FILE LINK-LOCATION DESCRIPTION)" t nil) - -(autoload 'org-insert-all-links "ol" "\ -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. - -\(fn ARG &optional PRE POST)" t nil) - -(autoload 'org-insert-last-stored-link "ol" "\ -Insert the last link stored in `org-stored-links'. - -\(fn ARG)" t nil) - -(autoload 'org-insert-link-global "ol" "\ -Insert a link like Org mode does. -This command can be called in any mode to insert a link in Org syntax." t nil) - -(autoload 'org-update-radio-target-regexp "ol" "\ -Find all radio targets in this file and update the regular expression. -Also refresh fontification if needed." t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol" '("org-"))) ;;;*** @@ -23418,7 +23319,7 @@ Coloring: ;;;### (autoloads nil "org" "org/org.el" (0 0 0 0)) ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 3)) package--builtin-versions) +(push (purecopy '(org 9 4 3)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -23443,6 +23344,11 @@ FULL is given. \(fn &optional HERE FULL MESSAGE)" t nil) +(autoload 'org-load-modules-maybe "org" "\ +Load all extensions listed in `org-modules'. + +\(fn &optional FORCE)" nil nil) + (autoload 'org-clock-persistence-insinuate "org" "\ Set up hooks for clock persistence." nil nil) @@ -23512,10 +23418,10 @@ 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. +As a special case, if point is at the very beginning of the buffer, if +there is no headline there, and if the variable `org-cycle-global-at-bob' +is non-nil, this function acts as if called with prefix argument (`\\[universal-argument] TAB', +same as `S-TAB') also when called without prefix argument. \(fn &optional ARG)" t nil) @@ -23611,278 +23517,10 @@ Call the customize function with org as argument." t nil) ;;;*** -;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-agenda" "org/org-agenda.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-agenda.el -(autoload 'org-toggle-sticky-agenda "org-agenda" "\ -Toggle `org-agenda-sticky'. - -\(fn &optional ARG)" t nil) - -(autoload 'org-agenda "org-agenda" "\ -Dispatch agenda commands to collect entries to the agenda buffer. -Prompts for a command to execute. Any prefix arg will be passed -on to the selected command. The default selections are: - -a Call `org-agenda-list' to display the agenda for current day or week. -t Call `org-todo-list' to display the global todo list. -T Call `org-todo-list' to display the global todo list, select only - entries with a specific TODO keyword (the user gets a prompt). -m Call `org-tags-view' to display headlines with tags matching - a condition (the user is prompted for the condition). -M Like `m', but select only TODO entries, no ordinary headlines. -e Export views to associated files. -s Search entries for keywords. -S Search entries for keywords, only with TODO keywords. -/ Multi occur across all agenda files and also files listed - in `org-agenda-text-search-extra-files'. -< Restrict agenda commands to buffer, subtree, or region. - Press several times to get the desired effect. -> Remove a previous restriction. -# List \"stuck\" projects. -! Configure what \"stuck\" means. -C Configure custom agenda commands. - -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 -first press `<' once to indicate that the agenda should be temporarily -\(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). - -\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil) - -(autoload 'org-batch-agenda "org-agenda" "\ -Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. -Parameters are alternating variable names and values that will be bound -before running the agenda command. - -\(fn CMD-KEY &rest PARAMETERS)" nil t) - -(autoload 'org-batch-agenda-csv "org-agenda" "\ -Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. -Parameters are alternating variable names and values that will be bound -before running the agenda command. - -The output gives a line for each selected agenda item. Each -item is a list of comma-separated values, like this: - -category,head,type,todo,tags,date,time,extra,priority-l,priority-n - -category The category of the item -head The headline, without TODO kwd, TAGS and PRIORITY -type The type of the agenda entry, can be - todo selected in TODO match - tagsmatch selected in tags match - diary imported from diary - deadline a deadline on given date - scheduled scheduled on given date - timestamp entry has timestamp on given date - closed entry was closed on given date - upcoming-deadline warning about deadline - past-scheduled forwarded scheduled item - block entry has date block including g. date -todo The todo keyword, if any -tags All tags including inherited ones, separated by colons -date The relevant date, like 2007-2-14 -time The time, like 15:00-16:50 -extra String with extra planning info -priority-l The priority letter if any was given -priority-n The computed numerical priority -agenda-day The day in the agenda where this is listed - -\(fn CMD-KEY &rest PARAMETERS)" nil t) - -(autoload 'org-store-agenda-views "org-agenda" "\ -Store agenda views. - -\(fn &rest PARAMETERS)" t nil) - -(autoload 'org-batch-store-agenda-views "org-agenda" "\ -Run all custom agenda commands that have a file argument. - -\(fn &rest PARAMETERS)" nil t) - -(autoload 'org-agenda-list "org-agenda" "\ -Produce a daily/weekly view from all files in variable `org-agenda-files'. -The view will be for the current day or week, but from the overview buffer -you will be able to go to other days/weeks. - -With a numeric prefix argument in an interactive call, the agenda will -span ARG days. Lisp programs should instead specify SPAN to change -the number of days. SPAN defaults to `org-agenda-span'. - -START-DAY defaults to TODAY, or to the most recent match for the weekday -given in `org-agenda-start-on-weekday'. - -When WITH-HOUR is non-nil, only include scheduled and deadline -items if they have an hour specification like [h]h:mm. - -\(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil) - -(autoload 'org-search-view "org-agenda" "\ -Show all entries that contain a phrase or words or regular expressions. - -With optional prefix argument TODO-ONLY, only consider entries that are -TODO entries. The argument STRING can be used to pass a default search -string into this function. If EDIT-AT is non-nil, it means that the -user should get a chance to edit this string, with cursor at position -EDIT-AT. - -The search string can be viewed either as a phrase that should be found as -is, or it can be broken into a number of snippets, each of which must match -in a Boolean way to select an entry. The default depends on the variable -`org-agenda-search-view-always-boolean'. -Even if this is turned off (the default) you can always switch to -Boolean search dynamically by preceding the first word with \"+\" or \"-\". - -The default is a direct search of the whole phrase, where each space in -the search string can expand to an arbitrary amount of whitespace, -including newlines. - -If using a Boolean search, the search string is split on whitespace and -each snippet is searched separately, with logical AND to select an entry. -Words prefixed with a minus must *not* occur in the entry. Words without -a prefix or prefixed with a plus must occur in the entry. Matching is -case-insensitive. Words are enclosed by word delimiters (i.e. they must -match whole words, not parts of a word) if -`org-agenda-search-view-force-full-words' is set (default is nil). - -Boolean search snippets enclosed by curly braces are interpreted as -regular expressions that must or (when preceded with \"-\") must not -match in the entry. Snippets enclosed into double quotes will be taken -as a whole, to include whitespace. - -- If the search string starts with an asterisk, search only in headlines. -- If (possibly after the leading star) the search string starts with an - exclamation mark, this also means to look at TODO entries only, an effect - that can also be achieved with a prefix argument. -- If (possibly after star and exclamation mark) the search string starts - with a colon, this will mean that the (non-regexp) snippets of the - Boolean search must match as full words. - -This command searches the agenda files, and in addition the files -listed in `org-agenda-text-search-extra-files' unless a restriction lock -is active. - -\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil) - -(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 -for a keyword. A numeric prefix directly selects the Nth keyword in -`org-todo-keywords-1'. - -\(fn &optional ARG)" t nil) - -(autoload 'org-tags-view "org-agenda" "\ -Show all headlines for all `org-agenda-files' matching a TAGS criterion. -The prefix arg TODO-ONLY limits the search to TODO entries. - -\(fn &optional TODO-ONLY MATCH)" t nil) - -(autoload 'org-agenda-list-stuck-projects "org-agenda" "\ -Create agenda view for projects that are stuck. -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'. - -\(fn &rest IGNORE)" t nil) - -(autoload 'org-diary "org-agenda" "\ -Return diary information from org files. -This function can be used in a \"sexp\" diary entry in the Emacs calendar. -It accesses org files and extracts information from those files to be -listed in the diary. The function accepts arguments specifying what -items should be listed. For a list of arguments allowed here, see the -variable `org-agenda-entry-types'. - -The call in the diary file should look like this: - - &%%(org-diary) ~/path/to/some/orgfile.org - -Use a separate line for each org file to check. Or, if you omit the file name, -all files listed in `org-agenda-files' will be checked automatically: - - &%%(org-diary) - -If you don't give any arguments (as in the example above), the default value -of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). -So the example above may also be written as - - &%%(org-diary :deadline :timestamp :sexp :scheduled) - -The function expects the lisp variables `entry' and `date' to be provided -by the caller, because this is how the calendar works. Don't use this -function from a program - use `org-agenda-get-day-entries' instead. - -\(fn &rest ARGS)" nil nil) - -(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\ -Do we have a reason to ignore this TODO entry because it has a time stamp? - -\(fn &optional END)" nil nil) - -(autoload 'org-agenda-set-restriction-lock "org-agenda" "\ -Set restriction lock for agenda to current subtree or file. -When in a restricted subtree, remove it. - -The restriction will span over the entire file if TYPE is `file', -or if type is '(4), or if the cursor is before the first headline -in the file. Otherwise, only apply the restriction to the current -subtree. - -\(fn &optional TYPE)" t nil) - -(autoload 'org-calendar-goto-agenda "org-agenda" "\ -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'." 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. - -If FILTER is t, interactively prompt the user for a regular -expression, and filter out entries that don't match it. - -If FILTER is a string, use this string as a regular expression -for filtering entries out. - -If FILTER is a function, filter out entries against which -calling the function returns nil. This function takes one -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\")) - -will only add headlines containing IMPORTANT or headlines -belonging to the \"Work\" category. - -ARGS are symbols indicating what kind of entries to consider. -By default `org-agenda-to-appt' will use :deadline*, :scheduled* -\(i.e., deadlines and scheduled items with a hh:mm specification) -and :timestamp entries. See the docstring of `org-diary' for -details and examples. - -If an entry has a APPT_WARNTIME property, its value will be used -to override `appt-message-warning-time'. - -\(fn &optional REFRESH FILTER &rest ARGS)" t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-agenda" '("org-"))) ;;;*** @@ -23911,48 +23549,10 @@ to override `appt-message-warning-time'. ;;;*** -;;;### (autoloads nil "org-capture" "org/org-capture.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-capture" +;;;;;; "org/org-capture.el" (0 0 0 0)) ;;; Generated autoloads from org/org-capture.el -(autoload 'org-capture-string "org-capture" "\ -Capture STRING with the template selected by KEYS. - -\(fn STRING &optional KEYS)" t nil) - -(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. - -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. - -When called with a `C-1' (one) prefix, force prompting for a date when -a datetree entry is made. - -ELisp programs can set KEYS to a string associated with a template -in `org-capture-templates'. In this case, interactive selection -will be bypassed. - -If `org-capture-use-agenda-date' is non-nil, capturing from the -agenda will use the date at point as the default date. Then, a -`C-1' prefix will tell the capture process to use the HH:MM time -of the day at point (if any) or the current HH:MM time. - -\(fn &optional GOTO KEYS)" t nil) - -(autoload 'org-capture-import-remember-templates "org-capture" "\ -Set `org-capture-templates' to be similar to `org-remember-templates'." t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-capture" '("org-capture-"))) ;;;*** @@ -23965,103 +23565,18 @@ Set `org-capture-templates' to be similar to `org-remember-templates'." t nil) ;;;*** -;;;### (autoloads nil "org-colview" "org/org-colview.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-colview" +;;;;;; "org/org-colview.el" (0 0 0 0)) ;;; Generated autoloads from org/org-colview.el -(autoload 'org-columns-remove-overlays "org-colview" "\ -Remove all currently active column overlays." t nil) - -(autoload 'org-columns-get-format-and-top-level "org-colview" nil nil nil) - -(autoload 'org-columns "org-colview" "\ -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 GLOBAL COLUMNS-FMT-STRING)" t nil) - -(autoload 'org-columns-compute "org-colview" "\ -Summarize the values of PROPERTY hierarchically. -Also update existing values for PROPERTY according to the first -column specification. - -\(fn PROPERTY)" t nil) - -(autoload 'org-dblock-write:columnview "org-colview" "\ -Write the column view table. - -PARAMS is a property list of parameters: - -`:id' (mandatory) - - 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 of the - buffer (usually this means that the whole buffer switches to - column view). When \"file:path/to/file.org\", invoke column - view at the start of that file. Otherwise, the ID is located - using `org-id-find'. - -`:exclude-tags' - - List of tags to exclude from column view table. - -`:format' - - When non-nil, specify the column view format to use. - -`:hlines' - - When non-nil, insert a hline before each item. When - a number, insert a hline before each level inferior or equal - to that number. - -`:indent' - - When non-nil, indent each ITEM field according to its level. - -`:match' - - When set to a string, use this as a tags/property match filter. - -`:maxlevel' - - When set to a number, don't capture headlines below this level. - -`:skip-empty-rows' - - When non-nil, skip rows where all specifiers other than ITEM - are empty. - -`:vlines' - - When non-nil, make each column a column group to enforce - vertical lines. - -\(fn PARAMS)" nil nil) - -(autoload 'org-columns-insert-dblock "org-colview" "\ -Create a dynamic block capturing a column view table." t nil) - -(autoload 'org-agenda-columns "org-colview" "\ -Turn on or update column view in the agenda." t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-colview" '("org-"))) ;;;*** -;;;### (autoloads nil "org-compat" "org/org-compat.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-compat" "org/org-compat.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-compat.el -(autoload 'org-check-version "org-compat" "\ -Try very hard to provide sensible version strings." nil t) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-compat" '("org-"))) ;;;*** @@ -24069,6 +23584,21 @@ Try very hard to provide sensible version strings." nil t) ;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0)) ;;; Generated autoloads from org/org-crypt.el +(autoload 'org-encrypt-entry "org-crypt" "\ +Encrypt the content of the current headline." t nil) + +(autoload 'org-decrypt-entry "org-crypt" "\ +Decrypt the content of the current headline." t nil) + +(autoload 'org-encrypt-entries "org-crypt" "\ +Encrypt all top-level entries in the current buffer." t nil) + +(autoload 'org-decrypt-entries "org-crypt" "\ +Decrypt all entries in the current buffer." t nil) + +(autoload 'org-crypt-use-before-save-magic "org-crypt" "\ +Add a hook to automatically encrypt entries before a file is saved to disk." nil nil) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-crypt" '("org-"))) ;;;*** @@ -24088,57 +23618,10 @@ Try very hard to provide sensible version strings." nil t) ;;;*** -;;;### (autoloads nil "org-duration" "org/org-duration.el" (0 0 0 -;;;;;; 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-duration" +;;;;;; "org/org-duration.el" (0 0 0 0)) ;;; Generated autoloads from org/org-duration.el -(autoload 'org-duration-set-regexps "org-duration" "\ -Set duration related regexps." t nil) - -(autoload 'org-duration-p "org-duration" "\ -Non-nil when string S is a time duration. - -\(fn S)" nil nil) - -(autoload 'org-duration-to-minutes "org-duration" "\ -Return number of minutes of DURATION string. - -When optional argument CANONICAL is non-nil, ignore -`org-duration-units' and use standard time units value. - -A bare number is translated into minutes. The empty string is -translated into 0.0. - -Return value as a float. Raise an error if duration format is -not recognized. - -\(fn DURATION &optional CANONICAL)" nil nil) - -(autoload 'org-duration-from-minutes "org-duration" "\ -Return duration string for a given number of MINUTES. - -Format duration according to `org-duration-format' or FMT, when -non-nil. - -When optional argument CANONICAL is non-nil, ignore -`org-duration-units' and use standard time units value. - -Raise an error if expected format is unknown. - -\(fn MINUTES &optional FMT CANONICAL)" nil nil) - -(autoload 'org-duration-h:mm-only-p "org-duration" "\ -Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format. - -TIMES is a list of duration strings. - -Return nil if any duration is expressed with units, as defined in -`org-duration-units'. Otherwise, if any duration is expressed -with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return -`h:mm'. - -\(fn TIMES)" nil nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-duration" '("org-duration-"))) ;;;*** @@ -24182,38 +23665,10 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return ;;;*** -;;;### (autoloads nil "org-goto" "org/org-goto.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-goto" "org/org-goto.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-goto.el -(autoload 'org-goto-location "org-goto" "\ -Let the user select a location in current buffer. -This function uses a recursive edit. It returns the selected -position or nil. - -\(fn &optional BUF HELP)" nil nil) - -(autoload 'org-goto "org-goto" "\ -Look up a different location in the current file, keeping current visibility. - -When you want look-up or go to a different location in a -document, the fastest way is often to fold the entire buffer and -then dive into the tree. This method has the disadvantage, that -the previous location will be folded, which may not be what you -want. - -This command works around this by showing a copy of the current -buffer in an indirect buffer, in overview mode. You can dive -into the tree in that copy, use org-occur and incremental search -to find a location. When pressing RET or `Q', the command -returns to the original buffer in which the visibility is still -unchanged. After RET it will also jump to the location selected -in the indirect buffer and expose the headline hierarchy above. - -With a prefix argument, use the alternative interface: e.g., if -`org-goto-interface' is `outline' use `outline-path-completion'. - -\(fn &optional ALTERNATIVE-INTERFACE)" t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-goto" '("org-goto-"))) ;;;*** @@ -24237,7 +23692,7 @@ With a prefix argument, use the alternative interface: e.g., if ;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-indent.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-indent-"))) ;;;*** @@ -24249,35 +23704,24 @@ With a prefix argument, use the alternative interface: e.g., if ;;;*** -;;;### (autoloads nil "org-keys" "org/org-keys.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-keys" "org/org-keys.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-keys.el -(autoload 'org-babel-describe-bindings "org-keys" "\ -Describe all keybindings behind `org-babel-key-prefix'." t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-keys" '("org-"))) ;;;*** -;;;### (autoloads nil "org-lint" "org/org-lint.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "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)) +;;;### (autoloads "actual autoloads are elsewhere" "org-list" "org/org-list.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-list.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-list" '("org-"))) @@ -24291,14 +23735,10 @@ ARG can also be a list of checker names, as symbols, to run. ;;;*** -;;;### (autoloads nil "org-macs" "org/org-macs.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-macs" "org/org-macs.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-macs.el -(autoload 'org-load-noerror-mustsuffix "org-macs" "\ -Load FILE with optional arguments NOERROR and MUSTSUFFIX. - -\(fn FILE)" nil t) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macs" '("org-"))) ;;;*** @@ -24318,25 +23758,10 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. ;;;*** -;;;### (autoloads nil "org-num" "org/org-num.el" (0 0 0 0)) +;;;### (autoloads "actual autoloads are elsewhere" "org-num" "org/org-num.el" +;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-num.el -(autoload 'org-num-default-format "org-num" "\ -Default numbering display function. -NUMBERING is a list of numbers. - -\(fn NUMBERING)" nil nil) - -(autoload 'org-num-mode "org-num" "\ -Dynamic numbering of headlines in an Org buffer. - -If called interactively, enable Org-Num mode if ARG is positive, and -disable it if ARG is zero or negative. If called from Lisp, also -enable the mode if ARG is omitted or nil, and toggle it if ARG is -`toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-num" '("org-num-"))) ;;;*** @@ -24363,6 +23788,14 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-protocol" '("org-protocol-"))) +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-refile" "org/org-refile.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-refile.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-refile" '("org-"))) + ;;;*** ;;;### (autoloads nil "org-src" "org/org-src.el" (0 0 0 0)) @@ -24503,8 +23936,7 @@ See the command `outline-mode' for more information on this mode. ;;;*** -;;;### (autoloads "actual autoloads are elsewhere" "ox-man" "org/ox-man.el" -;;;;;; (0 0 0 0)) +;;;### (autoloads nil "ox-man" "org/ox-man.el" (0 0 0 0)) ;;; Generated autoloads from org/ox-man.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-man" '("org-man-"))) @@ -38899,10 +38331,19 @@ Zone out, completely." t nil) ;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el" ;;;;;; "files.el" "font-core.el" "font-lock.el" "format.el" "frame.el" ;;;;;; "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" -;;;;;; "international/charscript.el" "international/cp51932.el" -;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" -;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el" -;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el" +;;;;;; "international/charprop.el" "international/charscript.el" +;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/mule-cmds.el" +;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" +;;;;;; "international/uni-brackets.el" "international/uni-category.el" +;;;;;; "international/uni-combining.el" "international/uni-comment.el" +;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" +;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" +;;;;;; "international/uni-mirrored.el" "international/uni-name.el" +;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" +;;;;;; "international/uni-special-lowercase.el" "international/uni-special-titlecase.el" +;;;;;; "international/uni-special-uppercase.el" "international/uni-titlecase.el" +;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el" +;;;;;; "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el" ;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el" ;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el" ;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el" @@ -38935,14 +38376,17 @@ Zone out, completely." t nil) ;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el" ;;;;;; "obarray.el" "org/ob-core.el" "org/ob-lob.el" "org/ob-matlab.el" ;;;;;; "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el" "org/ol-irc.el" -;;;;;; "org/org-archive.el" "org/org-attach.el" "org/org-clock.el" -;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el" -;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" -;;;;;; "org/org-install.el" "org/org-mobile.el" "org/org-plot.el" +;;;;;; "org/ol.el" "org/org-agenda.el" "org/org-archive.el" "org/org-attach.el" +;;;;;; "org/org-capture.el" "org/org-clock.el" "org/org-colview.el" +;;;;;; "org/org-compat.el" "org/org-datetree.el" "org/org-duration.el" +;;;;;; "org/org-element.el" "org/org-feed.el" "org/org-footnote.el" +;;;;;; "org/org-goto.el" "org/org-id.el" "org/org-indent.el" "org/org-install.el" +;;;;;; "org/org-keys.el" "org/org-lint.el" "org/org-list.el" "org/org-macs.el" +;;;;;; "org/org-mobile.el" "org/org-num.el" "org/org-plot.el" "org/org-refile.el" ;;;;;; "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" ;;;;;; "org/ox-html.el" "org/ox-icalendar.el" "org/ox-latex.el" -;;;;;; "org/ox-man.el" "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" -;;;;;; "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el" +;;;;;; "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" +;;;;;; "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el" ;;;;;; "progmodes/prog-mode.el" "ps-mule.el" "register.el" "replace.el" ;;;;;; "rfn-eshadow.el" "select.el" "simple.el" "startup.el" "subdirs.el" ;;;;;; "subr.el" "tab-bar.el" "textmodes/fill.el" "textmodes/page.el" diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 8191dd15cc4..19756d1cee6 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "27.1.50"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "27.1.90"/ /^#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 3c44c583afc..9c9228ef8f4 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2020 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 27.1.50 for MS-Windows + Emacs version 27.1.90 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 From fdaaf886b71fc41d0d6d717af55e4927ed4cd2c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 18 Dec 2020 15:38:27 +0000 Subject: [PATCH 128/148] Document that flymake-diag-region saves match data The typical use of this function (which is parsing compiler diagnostic messages), lends itself too easily to one the problems in bug#29193. Make it a friendlier API. * doc/misc/flymake.texi (Flymake utility functions): Document that flymake-diag-region saves match data. * lisp/progmodes/flymake.el (flymake-diag-region): Document that this saves match data. --- doc/misc/flymake.texi | 2 +- lisp/progmodes/flymake.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index b4757938e99..f4fc26d896b 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -581,7 +581,7 @@ can use the following function: Compute @var{buffer}'s region (@var{beg} . @var{end}) corresponding to @var{line} and @var{col}. If @var{col} is @code{nil}, return a region just for @var{line}. Return @code{nil} if the region is -invalid. +invalid. This function saves match data (@pxref{Saving Match Data}). @end deffn @cindex add a log message diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index dfb4f18cff7..40bb90d0f15 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -412,7 +412,7 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)." (defun flymake-diag-region (buffer line &optional col) "Compute BUFFER's region (BEG . END) corresponding to LINE and COL. If COL is nil, return a region just for LINE. Return nil if the -region is invalid." +region is invalid. This function saves match data." (condition-case-unless-debug _err (with-current-buffer buffer (let ((line (min (max line 1) From e0f98374ca639c600f3b891dfc502493556baf79 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 18 Dec 2020 22:34:30 +0000 Subject: [PATCH 129/148] ; Fix @pxref in last change to flymake.texi --- doc/misc/flymake.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index f4fc26d896b..8f2954bdf4f 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -581,7 +581,8 @@ can use the following function: Compute @var{buffer}'s region (@var{beg} . @var{end}) corresponding to @var{line} and @var{col}. If @var{col} is @code{nil}, return a region just for @var{line}. Return @code{nil} if the region is -invalid. This function saves match data (@pxref{Saving Match Data}). +invalid. This function saves match data (@pxref{Saving Match Data,,, +elisp, The Emacs Lisp Reference Manual}). @end deffn @cindex add a log message From f36971b59b5f7362bdabdbad60841cabd97e657a Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 18 Dec 2020 23:22:39 +0000 Subject: [PATCH 130/148] ; Fix grammar in recent change to internals.texi --- doc/lispref/internals.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 28a5fdb3492..fa3dacbb7ae 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -625,7 +625,7 @@ All the data here is approximate, because there's really no consistent way to compute the size of a variable. For instance, two variables may share parts of a data structure, and this will be counted twice, but this command may still give a useful high-level overview of which -parts of Emacs is using memory. +parts of Emacs are using memory. @end defun @node Stack-allocated Objects From c7fdc17c165a2206b56dc1f451927952edc3b60a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Dec 2020 18:29:52 -0500 Subject: [PATCH 131/148] * lisp/emacs-lisp/package.el (package-quickstart-refresh): Fix last change Actually allow byte-compiling the file. Reported by Basil L. Contovounesios . --- lisp/emacs-lisp/package.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f6ad6d2ebc7..fa93ffd0cc5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4100,7 +4100,6 @@ activations need to be changed, such as when `package-load-list' is modified." (insert " ;; Local\sVariables: ;; version-control: never -;;\sno-byte-compile: t ;; no-update-autoloads: t ;; End: ")) From 9f7e0a3e7d33d79f7f0319cd0fc64920988b0039 Mon Sep 17 00:00:00 2001 From: Roland Winkler Date: Fri, 18 Dec 2020 22:26:40 -0600 Subject: [PATCH 132/148] bibtex-mode: Permit user-defined schemes for sorting entries. * lisp/textmodes/bibtex.el (bibtex-maintain-sorted-entries): New allowed value (INDEX-FUN PREDICATE). (bibtex-entry-index, bibtex-lessp): Use it. (bibtex-init-sort): Rename from bibtex-init-sort-entry-class-alist. --- etc/NEWS | 4 ++ lisp/textmodes/bibtex.el | 100 ++++++++++++++++++++++++--------------- 2 files changed, 66 insertions(+), 38 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 87463372d57..4a8e70e6a62 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1481,6 +1481,10 @@ completions with more information in completion prefix and suffix. This new option allows the user to customize how case is converted when unifying entries. +--- +*** The user option `bibtex-maintain-sorted-entries' now permits +user-defined sorting schemes. + +++ *** 'format-seconds' can now be used for sub-second times. The new optional "," parameter has been added, and diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index a78219e3f69..cf193ca9b10 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -204,20 +204,34 @@ narrowed to just the entry." (defcustom bibtex-maintain-sorted-entries nil "If non-nil, BibTeX mode maintains all entries in sorted order. Allowed non-nil values are: -plain or t All entries are sorted alphabetically. -crossref All entries are sorted alphabetically unless an entry has a +plain or t Sort entries alphabetically by keys. +crossref Sort entries alphabetically by keys unless an entry has a crossref field. These crossrefed entries are placed in alphabetical order immediately preceding the main entry. entry-class The entries are divided into classes according to their entry type, see `bibtex-sort-entry-class'. Within each class - the entries are sorted alphabetically. + sort entries alphabetically by keys. +(INDEX-FUN PREDICATE) +(INDEX-FUN PREDICATE INIT-FUN) Sort entries using INDEX-FUN and PREDICATE. + Function INDEX-FUN is called for each entry with point at the + end of the head of the entry. Its return values are used to + sort the entries using PREDICATE. Function PREDICATE takes two + arguments INDEX1 and INDEX2 as returned by INDEX-FUN. + It should return non-nil if INDEX1 should sort before INDEX2. + If INIT-FUN is non-nil, it should be a function that is called + with no arguments to initialize the sorting. See also `bibtex-sort-ignore-string-entries'." :group 'bibtex + :version "28.1" :type '(choice (const nil) + (const t) (const plain) (const crossref) (const entry-class) - (const t)) + (group :tag "Custom scheme" + (function :tag "Index-Fun") + (function :tag "Predicate") + (option (function :tag "Init-Fun")))) :safe (lambda (a) (memq a '(nil t plain crossref entry-class)))) (defcustom bibtex-sort-entry-class @@ -3998,28 +4012,15 @@ If mark is active count entries in region, if not in whole buffer." (narrow-to-region (bibtex-beginning-of-entry) (bibtex-end-of-entry)))) -(defun bibtex-entry-index () - "Return index of BibTeX entry head at or past position of point. -The index is a list (KEY CROSSREF-KEY ENTRY-TYPE) that is used for sorting -the entries of the BibTeX buffer. CROSSREF-KEY is nil unless the value -of `bibtex-maintain-sorted-entries' is `crossref'. Move point to the end -of the head of the entry found. Return nil if no entry found." - (let ((case-fold-search t)) - (if (re-search-forward bibtex-entry-maybe-empty-head nil t) - (let ((key (bibtex-key-in-head)) - ;; all entry types should be downcase (for ease of comparison) - (entry-type (downcase (bibtex-type-in-head)))) - ;; Don't search CROSSREF-KEY if we don't need it. - (if (eq bibtex-maintain-sorted-entries 'crossref) - (let ((bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref" t))) - (list key - (if bounds (bibtex-text-in-field-bounds bounds t)) - entry-type)) - (list key nil entry-type)))))) - -(defun bibtex-init-sort-entry-class-alist () - "Initialize `bibtex-sort-entry-class-alist' (buffer-local)." +(define-obsolete-function-alias 'bibtex-init-sort-entry-class-alist + #'bibtex-init-sort "28.1") +(defun bibtex-init-sort (&optional parse) + "Initialize sorting of BibTeX entries. +If PARSE is non-nil, also parse BibTeX keys." + (if (or parse + (and (eq bibtex-maintain-sorted-entries 'crossref) + (functionp bibtex-reference-keys))) + (bibtex-parse-keys)) (unless (local-variable-p 'bibtex-sort-entry-class-alist) (setq-local bibtex-sort-entry-class-alist (let ((i -1) alist) @@ -4029,7 +4030,36 @@ of the head of the entry found. Return nil if no entry found." ;; All entry types should be downcase (for ease of comparison). (push (cons (if (stringp entry) (downcase entry) entry) i) alist))) - alist)))) + alist))) + ;; Custom sorting scheme + (if (and (consp bibtex-maintain-sorted-entries) + (nth 2 bibtex-maintain-sorted-entries)) + (funcall (nth 2 bibtex-maintain-sorted-entries)))) + +(defun bibtex-entry-index () + "Return index of BibTeX entry head at or past position of point. +The index is a list (KEY CROSSREF-KEY ENTRY-TYPE) that is used for sorting +the entries of the BibTeX buffer. CROSSREF-KEY is nil unless the value of +`bibtex-maintain-sorted-entries' is `crossref'. +If `bibtex-maintain-sorted-entries' is (INDEX-FUN ...), the index is the return +value of INDEX-FUN. Return nil if no entry found. +Move point to the end of the head of the entry found." + (let ((case-fold-search t)) + (if (re-search-forward bibtex-entry-maybe-empty-head nil t) + (if (consp bibtex-maintain-sorted-entries) + ;; Custom sorting scheme + (funcall (car bibtex-maintain-sorted-entries)) + (let ((key (bibtex-key-in-head)) + ;; ENTRY-TYPE should be downcase (for ease of comparison) + (entry-type (downcase (bibtex-type-in-head))) + bounds) + (list key + ;; Don't search CROSSREF-KEY if we don't need it. + (and (eq bibtex-maintain-sorted-entries 'crossref) + (setq bounds (bibtex-search-forward-field + "\\(OPT\\)?crossref" t)) + (bibtex-text-in-field-bounds bounds t)) + entry-type)))))) (defun bibtex-lessp (index1 index2) "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. @@ -4038,6 +4068,8 @@ The predicate depends on the variable `bibtex-maintain-sorted-entries'. If its value is nil use plain sorting." (cond ((not index1) (not index2)) ; indices can be nil ((not index2) nil) + ((consp bibtex-maintain-sorted-entries) + (funcall (cadr bibtex-maintain-sorted-entries) index1 index2)) ((eq bibtex-maintain-sorted-entries 'crossref) ;; CROSSREF-KEY may be nil or it can point to an entry ;; in another BibTeX file. In both cases we ignore CROSSREF-KEY. @@ -4074,10 +4106,7 @@ affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries are ignored." (interactive) (bibtex-beginning-of-first-entry) ; Needed by `sort-subr' - (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. - (if (and (eq bibtex-maintain-sorted-entries 'crossref) - (functionp bibtex-reference-keys)) - (bibtex-parse-keys)) ; Needed by `bibtex-lessp'. + (bibtex-init-sort) ; Needed by `bibtex-lessp'. (sort-subr nil 'bibtex-skip-to-valid-entry ; NEXTREC function 'bibtex-end-of-entry ; ENDREC function @@ -4228,10 +4257,7 @@ If `bibtex-maintain-sorted-entries' is non-nil, perform a binary search to look for place for KEY. This requires that buffer is sorted, see `bibtex-validate'. Return t if preparation was successful or nil if entry KEY already exists." - (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. - (if (and (eq bibtex-maintain-sorted-entries 'crossref) - (functionp bibtex-reference-keys)) - (bibtex-parse-keys)) ; Needed by `bibtex-lessp'. + (bibtex-init-sort) ; Needed by `bibtex-lessp'. (let ((key (nth 0 index)) key-exist) (cond ((or (null key) @@ -4322,9 +4348,7 @@ Return t if test was successful, nil otherwise." (setq syntax-error t) ;; Check for duplicate keys and correct sort order - (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. - (bibtex-parse-keys) ; Possibly needed by `bibtex-lessp'. - ; Always needed by subsequent global key check. + (bibtex-init-sort t) ; Needed by `bibtex-lessp' and global key check. (let (previous current key-list) (bibtex-progress-message "Checking for duplicate keys") (bibtex-map-entries From 64d97212f42bc0305560a0ae2cc2f16a3a851117 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 19 Dec 2020 13:18:11 +0200 Subject: [PATCH 133/148] Fix over-wide doc strings * lisp/vc/ediff-init.el (ediff-before-flag-bol) (ediff-after-flag-eol, ediff-before-flag-mol): * lisp/org/org-ctags.el (org-ctags-open-link-functions): * lisp/mail/feedmail.el (feedmail-sendmail-f-doesnt-sell-me-out): * lisp/language/ethio-util.el (ethio-use-three-dot-question) (ethio-quote-vowel-always, ethio-W-sixth-always): * lisp/gnus/nnvirtual.el (nnvirtual-mapping-table) (nnvirtual-mapping-offsets, nnvirtual-mapping-reads) (nnvirtual-mapping-marks, nnvirtual-info-installed): * lisp/gnus/gnus.el (charset): * lisp/gnus/deuglify.el (gnus-outlook-deuglify-unwrap-stop-chars) (gnus-outlook-deuglify-no-wrap-chars) (gnus-outlook-deuglify-attrib-cut-regexp): Fix doc strings to not exceed 80-column limits. (Bug#44858) --- lisp/gnus/deuglify.el | 10 +++++++--- lisp/gnus/gnus.el | 2 +- lisp/gnus/nnvirtual.el | 15 ++++++++++----- lisp/language/ethio-util.el | 10 +++++++--- lisp/mail/feedmail.el | 2 +- lisp/org/org-ctags.el | 2 +- lisp/vc/ediff-init.el | 6 +++--- src/xterm.c | 9 +++++++-- 8 files changed, 37 insertions(+), 19 deletions(-) diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 647f643c962..fdc5302a28f 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -250,21 +250,25 @@ :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil - "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line." + "Characters that, when at end of cited line, inhibit unwrapping. +When one of these characters is the last one on the cited line +above the possibly wrapped line, it disallows unwrapping." :version "22.1" :type '(radio (const :format "None " nil) (string :value ".?!")) :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-no-wrap-chars "`" - "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line." + "Characters that, when at beginning of line, inhibit unwrapping. +When one of these characters is the first one in the possibly +wrapped line, it disallows unwrapping." :version "22.1" :type 'string :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-attrib-cut-regexp "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, " - "Regular expression matching the beginning of an attribution line that should be cut off." + "Regexp matching beginning of attribution line that should be cut off." :version "22.1" :type 'regexp :group 'gnus-outlook-deuglify) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index abe7b1ae76a..8e8af1521fa 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1545,7 +1545,7 @@ Use with caution.") ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr) ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)) :variable-document - "Alist of regexps (to match group names) and default charsets to be used when reading." + "Alist of regexps (to match group names) and charsets to be used when reading." :variable-group gnus-charset :variable-type '(repeat (list (regexp :tag "Group") (symbol :tag "Charset"))) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 54c2f7be820..3e9e608a099 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -61,22 +61,27 @@ component group will show up when you enter the virtual group.") (defvoo nnvirtual-current-group nil) (defvoo nnvirtual-mapping-table nil - "Table of rules on how to map between component group and article number to virtual article number.") + "Table of rules for mapping groups and articles to virtual article numbers. +These rules determine how to map between component group and article number +on the one hand, and virtual article number on the other hand.") (defvoo nnvirtual-mapping-offsets nil - "Table indexed by component group to an offset to be applied to article numbers in that group.") + "Table of mapping offsets to be applied to article numbers in a group. +The table is indexed by component group number of the group.") (defvoo nnvirtual-mapping-len 0 "Number of articles in this virtual group.") (defvoo nnvirtual-mapping-reads nil - "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.") + "Compressed sequence of read articles on the virtual group. +It is computed from the unread status of individual component groups.") (defvoo nnvirtual-mapping-marks nil - "Compressed marks alist for the virtual group as computed from the marks of individual component groups.") + "Compressed marks alist for the virtual group. +It is computed from the marks of individual component groups.") (defvoo nnvirtual-info-installed nil - "T if we have already installed the group info for this group, and shouldn't blast over it again.") + "t if the group info for this group is already installed.") (defvoo nnvirtual-status-string "") diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index 55e59ab516f..263ddb235e3 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -113,17 +113,21 @@ vertically stacked dots. All SERA <--> FIDEL converters refer this variable.") (defvar ethio-use-three-dot-question nil - "Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots). + "If non-nil, associate ASCII question mark with Ethiopic question mark. +The Ethiopic old style question mark is three vertically stacked dots. If nil, associate ASCII question mark with Ethiopic stylized question mark. All SERA <--> FIDEL converters refer this variable.") (defvar ethio-quote-vowel-always nil - "Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion. + "Non-nil means always put an apostrophe before an isolated vowel. +This happens in FIDEL --> SERA conversions. Isolated vowels at +word beginning do not get an apostrophe put before them. If nil, put an apostrophe only between a 6th-form consonant and an isolated vowel.") (defvar ethio-W-sixth-always nil - "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.") + "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\". +This is instead of \"Wu\" in FIDEL --> SERA conversion.") (defvar ethio-numeric-reduction 0 "Degree of reduction in converting Ethiopic digits into Arabic digits. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 6effe139864..6f8c013ba35 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -622,7 +622,7 @@ to arrange for the message to get a From: line." (defcustom feedmail-sendmail-f-doesnt-sell-me-out nil - "Says whether the sendmail program issues a warning header if called with \"-f\". + "Whether sendmail should issue a warning header if called with \"-f\". The sendmail program has a useful feature to let you set the envelope FROM address via a command line option, \"-f\". Unfortunately, it also has a widely disliked default behavior of selling you out if you do that by inserting diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 08885d26f66..bb1f2b83647 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -165,7 +165,7 @@ See the ctags documentation for more information.") '(org-ctags-find-tag org-ctags-ask-rebuild-tags-file-then-find-tag org-ctags-ask-append-topic) - "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." + "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS by ORG-CTAGS." :group 'org-ctags :version "24.1" :type 'hook diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 04926af16ef..8974692751f 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -554,19 +554,19 @@ See the documentation string of `ediff-focus-on-regexp-matches' for details.") ;; Highlighting (defcustom ediff-before-flag-bol "->>" - "Flag placed before a highlighted block of differences, if block starts at beginning of a line." + "Flag placed before highlighted block of differences at beginning of a line." :type 'string :tag "Region before-flag at beginning of line" :group 'ediff) (defcustom ediff-after-flag-eol "<<-" - "Flag placed after a highlighted block of differences, if block ends at end of a line." + "Flag placed after highlighted block of differences that ends at end of line." :type 'string :tag "Region after-flag at end of line" :group 'ediff) (defcustom ediff-before-flag-mol "->>" - "Flag placed before a highlighted block of differences, if block starts in mid-line." + "Flag placed before highlighted block of differences that starts mid-line." :type 'string :tag "Region before-flag in the middle of line" :group 'ediff) diff --git a/src/xterm.c b/src/xterm.c index 3de0d2e73c0..7f8728e47c4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8947,7 +8947,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!f && (f = any) && configureEvent.xconfigure.window == FRAME_X_WINDOW (f) - && FRAME_VISIBLE_P(f)) + && (FRAME_VISIBLE_P(f) + || !(configureEvent.xconfigure.width <= 1 + && configureEvent.xconfigure.height <= 1))) { block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) @@ -8962,7 +8964,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = 0; } #endif - if (f && FRAME_VISIBLE_P(f)) + if (f + && (FRAME_VISIBLE_P(f) + || !(configureEvent.xconfigure.width <= 1 + && configureEvent.xconfigure.height <= 1))) { #ifdef USE_GTK /* For GTK+ don't call x_net_wm_state for the scroll bar From 2224a64d3110be09ab6e11771e0c835777f61f82 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 19 Dec 2020 15:25:08 +0200 Subject: [PATCH 134/148] ; Revert unintended change. --- src/xterm.c | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 7f8728e47c4..3de0d2e73c0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8947,9 +8947,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!f && (f = any) && configureEvent.xconfigure.window == FRAME_X_WINDOW (f) - && (FRAME_VISIBLE_P(f) - || !(configureEvent.xconfigure.width <= 1 - && configureEvent.xconfigure.height <= 1))) + && FRAME_VISIBLE_P(f)) { block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) @@ -8964,10 +8962,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = 0; } #endif - if (f - && (FRAME_VISIBLE_P(f) - || !(configureEvent.xconfigure.width <= 1 - && configureEvent.xconfigure.height <= 1))) + if (f && FRAME_VISIBLE_P(f)) { #ifdef USE_GTK /* For GTK+ don't call x_net_wm_state for the scroll bar From 8f91fe3063c1a4523520624054458229cc376d9b Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 19 Dec 2020 12:40:00 +0000 Subject: [PATCH 135/148] Set indent-tabs-mode for c-mode in .dir-locals.el * .dir-locals.el (c-mode): Enforce existing indent-tabs-mode policy. (Bug#34765) --- .dir-locals.el | 1 + 1 file changed, 1 insertion(+) diff --git a/.dir-locals.el b/.dir-locals.el index 27d50c60699..b313945936c 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -9,6 +9,7 @@ (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) (electric-quote-comment . nil) (electric-quote-string . nil) + (indent-tabs-mode . t) (mode . bug-reference-prog))) (objc-mode . ((c-file-style . "GNU") (electric-quote-comment . nil) From 4c7df434a0410a46157743045255c03395231cc6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 19 Dec 2020 16:24:55 +0100 Subject: [PATCH 136/148] Correct units and spacing in memory-report * lisp/emacs-lisp/memory-report.el (memory-report--format): Use IEC unit prefixes and a space before. --- lisp/emacs-lisp/memory-report.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 04ae87d9ea0..b532ddc56c5 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -232,11 +232,11 @@ by counted more than once." (defun memory-report--format (bytes) (setq bytes (/ bytes 1024.0)) - (let ((units '("kB" "MB" "GB" "TB"))) + (let ((units '("KiB" "MiB" "GiB" "TiB"))) (while (>= bytes 1024) (setq bytes (/ bytes 1024.0)) (setq units (cdr units))) - (format "%6.1f%s" bytes (car units)))) + (format "%6.1f %s" bytes (car units)))) (defun memory-report--gc-elem (elems type) (* (nth 1 (assq type elems)) From 5ab5c3898778406103e7183bf41c7d018077092b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 19 Dec 2020 17:26:58 +0100 Subject: [PATCH 137/148] Shorten over-wide docstrings in defcustoms * lisp/calc/calc.el (calc-embedded-announce-formula-alist) (calc-embedded-open-formula, calc-embedded-close-formula) (calc-matrix-mode): * lisp/cedet/semantic/imenu.el (semantic-imenu-sort-bucket-function): * lisp/emacs-lisp/find-func.el (find-feature-regexp): * lisp/emulation/cua-base.el (cua-paste-pop-rotate-temporarily): * lisp/emulation/viper-init.el (viper-fast-keyseq-timeout) (viper-related-files-and-buffers-ring): * lisp/emulation/viper-keym.el (viper-want-ctl-h-help): * lisp/gnus/gnus-art.el (gnus-article-banner-alist): * lisp/gnus/gnus-group.el (gnus-keep-same-level): * lisp/gnus/gnus-score.el (gnus-adaptive-word-length-limit): * lisp/gnus/gnus-sum.el (gnus-inhibit-user-auto-expire): * lisp/gnus/gnus-uu.el (gnus-uu-ignore-files-by-type) (gnus-uu-do-not-unpack-archives) (gnus-uu-unmark-articles-not-decoded) (gnus-uu-correct-stripped-uucode, gnus-uu-save-in-digest) (gnus-uu-post-include-before-composing): * lisp/gnus/gnus.el (gnus-use-long-file-name) (gnus-install-group-spam-parameters): * lisp/gnus/message.el (message-cite-style): * lisp/gnus/nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) (nnmail-cache-ignore-groups): * lisp/ido.el (ido-rewrite-file-prompt-functions): * lisp/mail/feedmail.el (feedmail-fiddle-plex-user-list) (feedmail-spray-address-fiddle-plex-list): * lisp/mh-e/mh-e.el (mh-annotate-msg-hook): * lisp/net/imap.el (imap-process-connection-type): * lisp/net/rcirc.el (rcirc-omit-threshold): * lisp/net/tramp-sh.el (tramp-copy-size-limit): * lisp/nxml/nxml-mode.el (nxml-default-buffer-file-coding-system): * lisp/obsolete/landmark.el (landmark-max-stall-time): * lisp/obsolete/tls.el (tls-checktrust): * lisp/org/org-indent.el (org-indent-mode-turns-off-org-adapt-indentation) (org-indent-mode-turns-on-hiding-stars): * lisp/org/org-protocol.el (org-protocol-project-alist): * lisp/progmodes/cc-vars.el (c-doc-comment-style): * lisp/progmodes/cperl-mode.el (cperl-indent-subs-specially): * lisp/progmodes/flymake-proc.el (flymake-proc-allowed-file-name-masks): * lisp/progmodes/hideif.el (hide-ifdef-expand-reinclusion-protection): * lisp/simple.el (minibuffer-history-case-insensitive-variables): * lisp/tab-bar.el (tab-bar-close-last-tab-choice): * lisp/textmodes/reftex-vars.el (reftex-special-environment-functions): * lisp/vc/ediff-init.el (ediff-startup-hook, ediff-cleanup-hook) (ediff-metachars): * lisp/vc/ediff-merg.el (ediff-show-clashes-only): * lisp/vc/ediff-mult.el (ediff-default-filtering-regexp): Shorten doc strings to not exceed 80-column limits. (Bug#44858) --- lisp/calc/calc.el | 9 +++++---- lisp/cedet/semantic/imenu.el | 3 ++- lisp/emacs-lisp/find-func.el | 2 +- lisp/emulation/cua-base.el | 10 +++++----- lisp/emulation/viper-init.el | 5 +++-- lisp/emulation/viper-keym.el | 2 +- lisp/gnus/gnus-art.el | 4 +++- lisp/gnus/gnus-group.el | 2 +- lisp/gnus/gnus-score.el | 2 +- lisp/gnus/gnus-sum.el | 3 ++- lisp/gnus/gnus-uu.el | 12 ++++++------ lisp/gnus/gnus.el | 5 +++-- lisp/gnus/message.el | 3 ++- lisp/gnus/nnmail.el | 5 +++-- lisp/ido.el | 2 +- lisp/mail/feedmail.el | 18 ++++++++++-------- lisp/mh-e/mh-e.el | 2 +- lisp/net/imap.el | 2 +- lisp/net/rcirc.el | 2 +- lisp/net/tramp-sh.el | 3 +-- lisp/nxml/nxml-mode.el | 6 ++++-- lisp/obsolete/landmark.el | 3 ++- lisp/obsolete/tls.el | 6 ++++-- lisp/org/org-indent.el | 6 ++---- lisp/org/org-protocol.el | 6 ++++-- lisp/progmodes/cc-vars.el | 3 ++- lisp/progmodes/cperl-mode.el | 4 +++- lisp/progmodes/flymake-proc.el | 6 ++++-- lisp/progmodes/hideif.el | 4 ++-- lisp/simple.el | 3 ++- lisp/tab-bar.el | 6 ++++-- lisp/textmodes/reftex-vars.el | 10 ++++++---- lisp/vc/ediff-init.el | 6 +++--- lisp/vc/ediff-merg.el | 2 +- lisp/vc/ediff-mult.el | 2 +- 35 files changed, 97 insertions(+), 72 deletions(-) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index bb02281111f..9b45a55aa57 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -266,18 +266,18 @@ (sgml-mode . "\n\\(\n\\)*") (xml-mode . "\n\\(\n\\)*") (texinfo-mode . "@c Embed\n\\(@c .*\n\\)*")) - "Alist of major modes with appropriate values for `calc-embedded-announce-formula'." + "Alist of major modes for `calc-embedded-announce-formula'." :type '(alist :key-type (symbol :tag "Major mode") :value-type (regexp :tag "Regexp to announce formula"))) (defcustom calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" - "A regular expression for the opening delimiter of a formula used by calc-embedded." + "Regexp for the opening delimiter of a formula used by `calc-embedded'." :type '(regexp)) (defcustom calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" - "A regular expression for the closing delimiter of a formula used by calc-embedded." + "Regexp for the closing delimiter of a formula used by calc-embedded." :type '(regexp)) (defcustom calc-embedded-open-close-formula-alist @@ -721,7 +721,8 @@ If nil, computations on numbers always yield numbers where possible.") (defcalcmodevar calc-matrix-mode nil "If `matrix', variables are assumed to be matrix-valued. If a number, variables are assumed to be NxN matrices. -If `sqmatrix', variables are assumed to be square matrices of an unspecified size. +If `sqmatrix', variables are assumed to be square matrices of an + unspecified size. If `scalar', variables are assumed to be scalar-valued. If nil, symbolic math routines make no assumptions about variables.") diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 25f7fdb8426..c910dc8fc6b 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -99,7 +99,8 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil." (defcustom semantic-imenu-sort-bucket-function nil "Function to use when sorting tags in the buckets of functions. -See `semantic-bucketize' and the FILTER argument for more details on this function." +See `semantic-bucketize' and the FILTER argument for more details +on this function." :group 'semantic-imenu :type '(radio (const :tag "No Sorting" nil) (const semantic-sort-tags-by-name-increasing) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index ee94e1fbff7..074e7db295b 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -103,7 +103,7 @@ Please send improvements and fixes to the maintainer." (defcustom find-feature-regexp (concat ";;; Code:") - "The regexp used by `xref-find-definitions' when searching for a feature definition. + "Regexp used by `xref-find-definitions' when searching for a feature definition. Note it may contain up to one `%s' at the place where `format' should insert the feature name." ;; We search for ";;; Code" rather than (feature '%s) because the diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 926305e6077..55578d06229 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -375,11 +375,11 @@ managers, so try setting this to nil, if prefix override doesn't work." (defcustom cua-paste-pop-rotate-temporarily nil "If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily. -This means that both \\[yank] and the first \\[yank-pop] in a sequence always insert -the most recently killed text. Each immediately following \\[cua-paste-pop] replaces -the previous text with the next older element on the `kill-ring'. -With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the most -recent \\[yank-pop] (or \\[yank]) command." +This means that both \\[yank] and the first \\[yank-pop] in a sequence always +insert the most recently killed text. Each immediately following \\[cua-paste-pop] +replaces the previous text with the next older element on the `kill-ring'. +With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the +most recent \\[yank-pop] (or \\[yank]) command." :type 'boolean :group 'cua) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 6c4afe519f2..c2aae9b87fb 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -475,7 +475,8 @@ text." ;; Fast keyseq and ESC keyseq timeouts (defcustom viper-fast-keyseq-timeout 200 - "Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined. + "Max milliseconds for a key sequence to be regarded as a Vi-style macro. +Only regard key sequence as a macro if it is defined. Setting this too high may slow down your typing. Setting this value too low will make it hard to use Vi-style timeout macros." :type 'integer @@ -705,7 +706,7 @@ If nil, the cursor will move backwards without deleting anything." (viper-deflocalvar viper-related-files-and-buffers-ring nil "") (defcustom viper-related-files-and-buffers-ring nil - "List of file and buffer names that are considered to be related to the current buffer. + "List of file and buffer names to consider related to the current buffer. Related buffers can be cycled through via :R and :P commands." :type 'boolean :group 'viper-misc) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index d76cf71b314..6a0fc2e9842 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -69,7 +69,7 @@ major mode in effect." :group 'viper) (defcustom viper-want-ctl-h-help nil - "If non-nil, C-h gets bound to help-command; otherwise, C-h gets the usual Vi bindings." + "If non-nil, bind C-h to help-command; otherwise, C-h gets the usual Vi bindings." :type 'boolean :group 'viper) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5b50bcbbe1f..79d4d9087fb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -289,7 +289,9 @@ asynchronously. The compressed face will be piped to this command." (defcustom gnus-article-banner-alist nil "Banner alist for stripping. For example, - ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" + ((egroups . (concat \"^[ \\t\\n]*-------------------+\\\\\" + \"( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?\" + \"....\\n\\\\(.+\\n\\\\)+\")))" :version "21.1" :type '(repeat (cons symbol regexp)) :group 'gnus-article-washing) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 24534a1b66d..9bb3ec765ff 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -60,7 +60,7 @@ :type 'string) (defcustom gnus-keep-same-level nil - "Non-nil means that the next newsgroup after the current will be on the same level. + "Non-nil means that the newsgroup after this one will be on the same level. When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 94f2cc310fa..33c5803f5ab 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -248,7 +248,7 @@ If you use score decays, you might want to set values higher than (integer :tag "Score")))))) (defcustom gnus-adaptive-word-length-limit nil - "Words of a length lesser than this limit will be ignored when doing adaptive scoring." + "Words shorter than this limit will be ignored when doing adaptive scoring." :version "22.1" :group 'gnus-score-adapt :type '(radio (const :format "Unlimited " nil) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 16152e252a0..b8b055c02ce 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -744,7 +744,8 @@ string with the suggested prefix." :type '(repeat character)) (defcustom gnus-inhibit-user-auto-expire t - "If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." + "If non-nil, user marking commands will not mark an article as expirable. +This is true even if the group has auto-expire turned on." :version "21.1" :group 'gnus-summary :type 'boolean) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 70aeac00d7f..5980051ee45 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -162,7 +162,7 @@ Note that this variable can be used in conjunction with the (regexp :format "%v"))) (defcustom gnus-uu-ignore-files-by-type nil - "A regular expression saying what files that shouldn't be viewed, based on MIME file type. + "Regexp matching files that shouldn't be viewed, based on MIME file type. If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like @@ -224,7 +224,7 @@ Default is \"/tmp/\"." :type 'directory) (defcustom gnus-uu-do-not-unpack-archives nil - "Non-nil means that gnus-uu won't peek inside archives looking for files to display. + "If non-nil, gnus-uu won't peek inside archives looking for files to display. Default is nil." :group 'gnus-extract-archive :type 'boolean) @@ -265,19 +265,19 @@ it nil." :type 'boolean) (defcustom gnus-uu-unmark-articles-not-decoded nil - "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. + "If non-nil, gnus-uu will mark unsuccessfully decoded articles as unread. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-correct-stripped-uucode nil - "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. + "If non-nil, *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-save-in-digest nil - "Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. + "If non-nil, gnus-uu, when asked to save without decoding, will save in digests. If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - no easy way to specify any meaningful volume and issue numbers were found, @@ -1858,7 +1858,7 @@ uuencode and adds MIME headers." (function :tag "Other"))) (defcustom gnus-uu-post-include-before-composing nil - "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. + "If non-nil, gnus-uu asks for a file to encode before you compose the article. If this variable is t, you can either include an encoded file with \\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article." :group 'gnus-extract-post diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 8e8af1521fa..653ef1bbfdb 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1195,7 +1195,7 @@ Also see `gnus-large-ephemeral-newsgroup'." integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) - "Non-nil means that the default name of a file to save articles in is the group name. + "Non-nil means that the default file name to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If this variable is a list, and the list contains the element @@ -1618,7 +1618,8 @@ total number of articles in the group.") ;; group parameters for spam processing added by Ted Zlatanov (defcustom gnus-install-group-spam-parameters t "Disable the group parameters for spam detection. -Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." +Enable if `G c' in XEmacs is giving you trouble, and make sure to +submit a bug report." :version "22.1" :type 'boolean :group 'gnus-start) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b6c1c0b0713..cf4020c874c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1172,7 +1172,8 @@ Presets to impersonate popular mail agents are found in the message-cite-style-* variables. This variable is intended for use in `gnus-posting-styles', such as: - ((posting-from-work-p) (eval (setq-local message-cite-style message-cite-style-outlook)))" + ((posting-from-work-p) (eval (setq-local message-cite-style + message-cite-style-outlook)))" :version "24.1" :group 'message-insertion :type '(choice (const :tag "Do not override variables" :value nil) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 57801d6f9e6..6ee29a25cd8 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -115,7 +115,7 @@ If nil, the first match found will be used." :type 'boolean) (defcustom nnmail-split-fancy-with-parent-ignore-groups nil - "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. + "Regexp matching group names ignored by `nnmail-split-fancy-with-parent'. This can also be a list of regexps." :version "22.1" :group 'nnmail-split @@ -124,7 +124,8 @@ This can also be a list of regexps." (repeat :value (".*") regexp))) (defcustom nnmail-cache-ignore-groups nil - "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). + "Regexp matching group ignored when inserting message ids into the cache. +This is used by `nnmail-cache-insert'. This can also be a list of regexps." :version "22.1" :group 'nnmail-split diff --git a/lisp/ido.el b/lisp/ido.el index 99241ce1a3a..277ce15a3a9 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -842,7 +842,7 @@ variables: max-width - the max width of the resulting dirname; nil means no limit prompt - the basic prompt (e.g. \"Find File: \") literal - the string shown if doing \"literal\" find; set to nil to omit - vc-off - the string shown if version control is inhibited; set to nil to omit + vc-off - the string shown if version control is inhibited; use nil to omit prefix - either nil or a fixed prefix for the dirname The following variables are available, but should not be changed: diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 6f8c013ba35..2907093ea71 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -807,7 +807,8 @@ fiddle-plex. feedmail will use this list of fiddle-plexes to manipulate user-specified message header fields. It does this after it has completed all normal -message header field manipulation and before calling `feedmail-last-chance-hook'. +message header field manipulation and before calling +`feedmail-last-chance-hook'. For an explanation of fiddle-plexes, see the documentation for the variable `feedmail-fiddle-plex-blurb'. In contrast to some other fiddle-plex @@ -889,13 +890,14 @@ called and will consult `feedmail-spray-this-address' to find the stripped envelope email address (no comments or angle brackets). The function should return an embellished form of the address. -The recipe for sending form letters is: (1) create a message with all -addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers -before sending the message; (3) create a function which will embellish -stripped addresses, if desired; (4) define `feedmail-spray-address-fiddle-plex-list' -appropriately; (5) send the message with `feedmail-enable-spray' set -non-nil; (6) stand back and watch co-workers wonder at how efficient -you are at accomplishing inherently inefficient things." +The recipe for sending form letters is: (1) create a message with +all addressees on Bcc: headers; (2) tell feedmail to remove Bcc: +headers before sending the message; (3) create a function which +will embellish stripped addresses, if desired; (4) define +`feedmail-spray-address-fiddle-plex-list' appropriately; (5) send +the message with `feedmail-enable-spray' set non-nil; (6) stand +back and watch co-workers wonder at how efficient you are at +accomplishing inherently inefficient things." :group 'feedmail-spray :type 'sexp ; too complex to be described accurately ) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 3ac5c8f7aed..e5f69a5ae8d 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -3182,7 +3182,7 @@ folder, which is also available in `mh-current-folder'." :package-version '(MH-E . "8.0")) (defcustom-mh mh-annotate-msg-hook nil - "Hook run whenever a message is sent and after the scan lines and message are annotated. + "Hook run when a message is sent and after annotating the scan lines and message. Hook functions can access the current folder name with `mh-current-folder' and obtain the message numbers of the annotated messages with `mh-annotate-list'." diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 0394f0efeae..27c2d869f6b 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -190,7 +190,7 @@ until a successful connection is made." :type '(repeat string)) (defcustom imap-process-connection-type nil - "Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL. + "Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell and SSL. The `process-connection-type' variable controls the type of device used to communicate with subprocesses. Values are nil to use a pipe, or t or `pty' to use a pty. The value has no effect if the diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c4b68f1be4e..6a32fa9255b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1507,7 +1507,7 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (make-variable-buffer-local 'rcirc-last-sender) (defcustom rcirc-omit-threshold 100 - "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted." + "Lines since last activity from a nick before `rcirc-omit-responses' are omitted." :type 'integer) (defcustom rcirc-log-process-buffers nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e30fe61de43..e6e718ebe3b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -58,8 +58,7 @@ If it is nil, no compression at all will be applied." ;;;###tramp-autoload (defcustom tramp-copy-size-limit 10240 - "The maximum file size where inline copying is preferred over an \ -out-of-the-band copy. + "Maximum file size where inline copying is preferred to an out-of-the-band copy. If it is nil, out-of-the-band copy will be used without a check." :group 'tramp :type '(choice (const nil) integer)) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 5bb904e6915..080b8c0c6e8 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -107,8 +107,10 @@ and when the encoding declaration specifies `UTF-16'." (defcustom nxml-default-buffer-file-coding-system nil "Default value for `buffer-file-coding-system' for a buffer for a new file. -A value of nil means use the default value of `buffer-file-coding-system' as normal. -A buffer's `buffer-file-coding-system' affects what \\[nxml-insert-xml-declaration] inserts." +A value of nil means use the default value of +`buffer-file-coding-system' as normal. +A buffer's `buffer-file-coding-system' affects what +\\[nxml-insert-xml-declaration] inserts." :group 'nxml :type 'coding-system) diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el index df3c5d6cc9e..39e0f50e731 100644 --- a/lisp/obsolete/landmark.el +++ b/lisp/obsolete/landmark.el @@ -1278,7 +1278,8 @@ Used to move the robot when he is stuck in a rut for some reason." :group 'landmark) (defcustom landmark-max-stall-time 2 "The maximum number of cycles that the robot can remain stuck in a place. -After this limit is reached, landmark-random-move is called to push him out of it." +After this limit is reached, landmark-random-move is called to +push him out of it." :type 'integer :group 'landmark) diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el index d1b215cbfb8..a9d7b843736 100644 --- a/lisp/obsolete/tls.el +++ b/lisp/obsolete/tls.el @@ -130,8 +130,10 @@ the external program knows about the root certificates you consider trustworthy, e.g.: \(setq tls-program - \\='(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\" - \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\"))" + \\='(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt \\ +-p %p %h\" + \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt \\ +-p %p %h --protocols ssl3\"))" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask)) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 73b077965c4..708b5c305ef 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -85,15 +85,13 @@ it may be prettier to customize the `org-indent' face." :type 'character) (defcustom org-indent-mode-turns-off-org-adapt-indentation t - "Non-nil means setting the variable `org-indent-mode' will \ -turn off indentation adaptation. + "Non-nil means setting `org-indent-mode' will turn off indentation adaptation. For details see the variable `org-adapt-indentation'." :group 'org-indent :type 'boolean) (defcustom org-indent-mode-turns-on-hiding-stars t - "Non-nil means setting the variable `org-indent-mode' will \ -turn on `org-hide-leading-stars'." + "Non-nil means setting `org-indent-mode' will turn on `org-hide-leading-stars'." :group 'org-indent :type 'boolean) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 4bc7cee31fc..92ec24415b7 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -181,7 +181,8 @@ Possible properties are: :working-directory - the local working directory. This is, what base-url will be replaced with. :redirects - A list of cons cells, each of which maps a regular - expression to match to a path relative to :working-directory. + expression to match to a path relative to + :working-directory. Example: @@ -202,7 +203,8 @@ Example: :working-directory \"~/site/content/post/\" :online-suffix \".html\" :working-suffix \".md\" - :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\"))) + :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" + . \".md\"))) (\"GNU emacs OpenGrok\" :base-url \"https://opengrok.housegordon.com/source/xref/emacs/\" :working-directory \"~/dev/gnu-emacs/\"))) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 9e6f9527ca1..8772ed06324 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -575,7 +575,8 @@ comment styles: javadoc -- Javadoc style for \"/** ... */\" comments (default in Java mode). autodoc -- Pike autodoc style for \"//! ...\" comments (default in Pike mode). - gtkdoc -- GtkDoc style for \"/** ... **/\" comments (default in C and C++ modes). + gtkdoc -- GtkDoc style for \"/** ... **/\" comments + (default in C and C++ modes). doxygen -- Doxygen style. The value may also be a list of doc comment styles, in which case all diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 15987a3b9b1..87542ea133c 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -232,7 +232,9 @@ Versions 5.2 ... 5.20 behaved as if this were nil." :group 'cperl-indentation-details) (defcustom cperl-indent-subs-specially t - "Non-nil means indent subs that are inside other blocks (hash values, for example) relative to the beginning of the \"sub\" keyword, rather than relative to the statement that contains the declaration." + "If non-nil, indent subs inside other blocks relative to \"sub\" keyword. +Otherwise, indent them relative to statement that contains the declaration. +This applies to, for example, hash values." :type 'boolean :group 'cperl-indentation-details) diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 152dc725c74..744c110f6b0 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -120,8 +120,10 @@ 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-proc-simple-cleanup'. -NAME is the file name function to use, default `flymake-proc-get-real-file-name'." +CLEANUP is the cleanup function to use, default + `flymake-proc-simple-cleanup'. +NAME is the file name function to use, default + `flymake-proc-get-real-file-name'." :group 'flymake :type '(alist :key-type (regexp :tag "File regexp") :value-type diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 9c8343fca00..fb487f7e1f2 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -153,8 +153,8 @@ The first time we visit such a file, _XXX_HEADER_FILE_INCLUDED_ is undefined, and so nothing is hidden. The next time we visit it, everything will be hidden. -This behavior is generally undesirable. If this option is non-nil, the outermost -#if is always visible." +This behavior is generally undesirable. If this option is non-nil, the +outermost #if is always visible." :type 'boolean :version "25.1") diff --git a/lisp/simple.el b/lisp/simple.el index 090162b973a..9ed7a11de19 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2200,7 +2200,8 @@ in this use of the minibuffer.") "Minibuffer history variables for which matching should ignore case. If a history variable is a member of this list, then the \\[previous-matching-history-element] and \\[next-matching-history-element]\ - commands ignore case when searching it, regardless of `case-fold-search'." + commands ignore case when searching it, +regardless of `case-fold-search'." :type '(repeat variable) :group 'minibuffer) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 9506b1b22ea..8c649bd507a 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -852,8 +852,10 @@ If `recent', select the most recently visited tab." "Defines what to do when the last tab is closed. If nil, do nothing and show a message, like closing the last window or frame. If `delete-frame', delete the containing frame, as a web browser would do. -If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in the frame. -If the value is a function, call that function with the tab to be closed as an argument." +If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in +the frame. +If the value is a function, call that function with the tab to be closed as an + argument." :type '(choice (const :tag "Do nothing and show message" nil) (const :tag "Close the containing frame" delete-frame) (const :tag "Disable tab-bar-mode" tab-bar-mode-disable) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index c9fd19d2324..f73b849b6dd 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -741,8 +741,8 @@ The function must take an argument BOUND. If non-nil, BOUND is a boundary for backwards searches which should be observed. Here is an example. The LaTeX package linguex.sty defines list macros -`\\ex.', `\\a.', etc for lists which are terminated by `\\z.' or an empty -line. +`\\ex.', `\\a.', etc for lists which are terminated by `\\z.' or an +empty line. \\ex. \\label{ex:12} Some text in an exotic language ... \\a. \\label{ex:13} more stuff @@ -766,10 +766,12 @@ And here is the setup for RefTeX: (save-excursion ;; Search for any of the linguex item macros at the beginning of a line (if (re-search-backward - \"^[ \\t]*\\\\(\\\\\\\\\\\\(ex\\\\|a\\\\|b\\\\|c\\\\|d\\\\|e\\\\|f\\\\)g?\\\\.\\\\)\" bound t) + (concat \"^[ \\t]*\\\\(\\\\\\\\\\\\(ex\\\\|a\\\\|\" + \"b\\\\|c\\\\|d\\\\|e\\\\|f\\\\)g?\\\\.\\\\)\") + bound t) (progn (setq p1 (match-beginning 1)) - ;; Make sure no empty line or \\z. is between us and the item macro + ;; Make sure no empty line or \\z. is between us and item macro (if (re-search-forward \"\\n[ \\t]*\\n\\\\|\\\\\\\\z\\\\.\" pos t) ;; Return nil because list was already closed nil diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 8974692751f..3d16f316a63 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -432,7 +432,7 @@ Can be used to move the frame where it is desired." :type 'hook :group 'ediff-hook) (defcustom ediff-startup-hook nil - "Hooks to run in the control buffer after Ediff has been set up and is ready for the job." + "Hooks to run in the control buffer after Ediff has been set up and is ready." :type 'hook :group 'ediff-hook) (defcustom ediff-select-hook nil @@ -480,7 +480,7 @@ set local variables that determine how the display looks like." :type 'hook :group 'ediff-hook) (defcustom ediff-cleanup-hook nil - "Hooks to run on exiting Ediff but before killing the control and variant buffers." + "Hooks to run on exiting Ediff, before killing the control and variant buffers." :type 'hook :group 'ediff-hook) @@ -1268,7 +1268,7 @@ Instead, C-h would jump to previous difference." ;; Metacharacters that have to be protected from the shell when executing ;; a diff/diff3 command. (defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" - "Regexp that matches characters that must be quoted with `\\' in shell command line. + "Regexp matching characters that must be quoted with `\\' in shell command line. This default should work without changes." :type 'regexp :group 'ediff) diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index 22656761d91..1c1d5219c7b 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -70,7 +70,7 @@ STRING4 :group 'ediff-merge) (defcustom ediff-show-clashes-only nil - "If t, show only those diff regions where both buffers disagree with the ancestor. + "If t, show only diff regions where both buffers disagree with the ancestor. This means that regions that have status prefer-A or prefer-B will be skipped over. A value of nil means show all regions." :type 'boolean diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index b48377815a4..3d79630f3bb 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -181,7 +181,7 @@ directories.") (defvar ediff-filtering-regexp-history nil "") (defcustom ediff-default-filtering-regexp nil - "The default regular expression used as a filename filter in multifile comparisons. + "Default regular expression used as a filename filter in multifile comparisons. Should be a sexp. For instance (car ediff-filtering-regexp-history) or nil." :type 'sexp ; yuck - why not just a regexp? :risky t) From f88a7897a80ee9129bdc444cafff32d026c4b6d8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 19 Dec 2020 17:35:50 +0100 Subject: [PATCH 138/148] Shorten over-wide docstrings in variables * lisp/cedet/semantic/util-modes.el (semantic-highlight-func-popup-menu): * lisp/emacs-lisp/elint.el (elint-top-form-logged): * lisp/erc/erc-dcc.el (erc-dcc-list): * lisp/expand.el (expand-pos): * lisp/font-lock.el (cpp-font-lock-keywords-source-depth): * lisp/gnus/gnus-sum.el (gnus-sort-gathered-threads-function): * lisp/gnus/message.el (message-cite-style-thunderbird): * lisp/gnus/nnmh.el (nnmh-be-safe): * lisp/gnus/nntp.el (nntp-open-telnet-envuser): * lisp/international/mule-cmds.el (current-transient-input-method): * lisp/net/tramp.el (tramp-file-name-structure): * lisp/org/ob-R.el (org-babel-R-write-object-command): * lisp/org/org-attach.el (org-attach-after-change-hook): * lisp/org/org.el (org-stamp-time-of-day-regexp): * lisp/progmodes/elisp-mode.el (elisp-xref-find-def-functions): * lisp/progmodes/ruby-mode.el (ruby-block-mid-re): * lisp/progmodes/verilog-mode.el (verilog-cache-enabled): * lisp/term.el (term-scroll-end): * lisp/textmodes/table.el (table-command-remap-alist) (table-inhibit-auto-fill-paragraph, table-command-remap-alist): * lisp/vc/ediff-diff.el (ediff-ignore-similar-regions): * lisp/vc/ediff-wind.el (ediff-mouse-pixel-threshold): * lisp/vc/smerge-mode.el (smerge-refine-ignore-whitespace): * lisp/vc/vc.el (vc-log-short-style): * lisp/view.el (view-exit-action): Shorten doc strings to not exceed 80-column limits. (Bug#44858) --- lisp/cedet/semantic/util-modes.el | 3 ++- lisp/emacs-lisp/elint.el | 2 +- lisp/erc/erc-dcc.el | 3 ++- lisp/expand.el | 2 +- lisp/font-lock.el | 4 ++-- lisp/gnus/gnus-sum.el | 6 +++--- lisp/gnus/message.el | 3 ++- lisp/gnus/nnmh.el | 2 +- lisp/gnus/nntp.el | 3 ++- lisp/international/mule-cmds.el | 2 +- lisp/net/tramp.el | 4 ++-- lisp/org/ob-R.el | 2 +- lisp/org/org-attach.el | 2 +- lisp/org/org.el | 3 ++- lisp/progmodes/elisp-mode.el | 2 +- lisp/progmodes/ruby-mode.el | 2 +- lisp/progmodes/verilog-mode.el | 3 ++- lisp/term.el | 4 ++-- lisp/textmodes/table.el | 8 +++++--- lisp/vc/ediff-diff.el | 2 +- lisp/vc/ediff-wind.el | 2 +- lisp/vc/smerge-mode.el | 2 +- lisp/vc/vc.el | 5 +++-- lisp/view.el | 3 ++- 24 files changed, 42 insertions(+), 32 deletions(-) diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 776c6b1894e..8bfee432c3f 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -837,7 +837,8 @@ Argument EVENT describes the event that caused this function to be called." "Keymap for highlight-func minor mode.") (defvar semantic-highlight-func-popup-menu nil - "Menu used if the user clicks on the header line used by `semantic-highlight-func-mode'.") + "Menu used if the user clicks on the header line. +Used by `semantic-highlight-func-mode'.") (easy-menu-define semantic-highlight-func-popup-menu diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 79b72ff969f..d0a0389b3b7 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -521,7 +521,7 @@ Return nil if there are no more forms, t otherwise." "The currently linted top form, or nil.") (defvar elint-top-form-logged nil - "The value t if the currently linted top form has been mentioned in the log buffer.") + "Non-nil if the currently linted top form has been mentioned in the log buffer.") (defun elint-top-form (form) "Lint a top FORM." diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 1bce986a806..04508a44b60 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -83,7 +83,8 @@ All values of the list must be uppercase strings.") (defvar erc-dcc-list nil "List of DCC connections. Looks like: - ((:nick \"nick!user@host\" :type GET :peer proc :parent proc :size size :file file) + ((:nick \"nick!user@host\" :type GET :peer proc + :parent proc :size size :file file) (:nick \"nick!user@host\" :type CHAT :peer proc :parent proc) (:nick \"nick\" :type SEND :peer server-proc :parent parent-proc :file file :sent :confirmed )) diff --git a/lisp/expand.el b/lisp/expand.el index 77e4fc2657c..c4e1d227906 100644 --- a/lisp/expand.el +++ b/lisp/expand.el @@ -290,7 +290,7 @@ If ARG is omitted, point is placed at the end of the expanded text." (defvar expand-list nil "Temporary variable used by the Expand package.") (defvar expand-pos nil - "If non-nil, stores a vector containing markers to positions defined by the last expansion.") + "If non-nil, store a vector with position markers defined by the last expansion.") (make-variable-buffer-local 'expand-pos) (defvar expand-index 0 diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 0e771e8e0a5..a2cf71f9465 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2280,8 +2280,8 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." ;; "ifndef" "import" "include" "line" "pragma" "undef" "warning"))) ;; (defconst cpp-font-lock-keywords-source-depth 0 - "An integer representing regular expression depth of `cpp-font-lock-keywords-source-directives'. -Used in `cpp-font-lock-keywords'.") + "Regular expression depth of `cpp-font-lock-keywords-source-directives'. +This should be an integer. Used in `cpp-font-lock-keywords'.") (defconst cpp-font-lock-keywords (let* ((directives cpp-font-lock-keywords-source-directives) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b8b055c02ce..a0e7173998b 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1400,7 +1400,7 @@ the normal Gnus MIME machinery." (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) (defvar gnus-sort-gathered-threads-function #'gnus-thread-sort-by-number - "Function called to sort the articles within a thread after it has been gathered together.") + "Function to sort articles within a thread after it has been gathered together.") (defvar gnus-summary-save-parts-type-history nil) (defvar gnus-summary-save-parts-last-directory mm-default-directory) @@ -1526,7 +1526,7 @@ the type of the variable (string, integer, character, etc).") "Default shell command on article.") (defvar gnus-newsgroup-agentized nil - "Locally bound in each summary buffer to indicate whether the server has been agentized.") + "Locally bound in each summary buffer to indicate if server has been agentized.") (defvar gnus-newsgroup-begin nil) (defvar gnus-newsgroup-end nil) (defvar gnus-newsgroup-last-rmail nil) @@ -1556,7 +1556,7 @@ the type of the variable (string, integer, character, etc).") (defvar gnus-newsgroup-expunged-tally nil) (defvar gnus-newsgroup-marked nil - "Sorted list of ticked articles in the current newsgroup (a subset of unread art).") + "Sorted list of ticked articles in current newsgroup (a subset of unread art).") (defvar gnus-newsgroup-spam-marked nil "List of ranges of articles that have been marked as spam.") diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index cf4020c874c..86800f28cc4 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1200,7 +1200,8 @@ use in `gnus-posting-styles', such as: (message-yank-cited-prefix ">") (message-yank-empty-prefix ">") (message-citation-line-format "On %D %R %p, %N wrote:")) - "Message citation style used by Mozilla Thunderbird. Use with `message-cite-style'.") + "Message citation style used by Mozilla Thunderbird. +Use with `message-cite-style'.") (defconst message-cite-style-gmail '((message-cite-function 'message-cite-original) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 581a408009d..5584dad45f1 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -46,7 +46,7 @@ "Hook run narrowed to an article before saving.") (defvoo nnmh-be-safe nil - "If non-nil, nnmh will check all articles to make sure whether they are new or not. + "If non-nil, nnmh will check all articles to make sure if they are new or not. Go through the .nnmh-articles file and compare with the actual articles in this folder. The articles that are \"new\" will be marked as unread by Gnus.") diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index a5c82447926..887dce3472f 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1751,7 +1751,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the ;; ========================================================================== (defvoo nntp-open-telnet-envuser nil - "If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.") + "If non-nil, telnet session supports the ENVIRON option. +Don't prompt for login name. This applies to both client and server.") (defvoo nntp-telnet-shell-prompt "bash\\|[$>] *\r?$" "Regular expression to match the shell prompt on the remote machine.") diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index d59f2c0ebfc..e61c66e3328 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1356,7 +1356,7 @@ This is the input method activated by the command :version "28.1") (defvar current-transient-input-method nil - "The current input method temporarily enabled by `activate-transient-input-method'. + "Current input method temporarily enabled by `activate-transient-input-method'. If nil, that means no transient input method is active now.") (make-variable-buffer-local 'current-transient-input-method) (put 'current-transient-input-method 'permanent-local t) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 30818fe7e64..6c1c09bc371 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1022,8 +1022,8 @@ See `tramp-file-name-structure'." 5 6 7 8 1)) (defvar tramp-file-name-structure nil ;Initialized when defining `tramp-syntax'! - "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \ -the Tramp file name structure. + "List detailing the Tramp file name structure. +This is a list of six elements (REGEXP METHOD USER HOST FILE HOP). The first element REGEXP is a regular expression matching a Tramp file name. The regex should contain parentheses around the method name, diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 5e9d35f58e2..b4cf360730d 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -361,7 +361,7 @@ Each member of this list is a list with three members: ) } }(object=%s,transfer.file=\"%s\")" - "A template for an R command to evaluate a block of code and write the result to a file. + "Template for an R command to evaluate a block of code and write result to file. Has four %s escapes to be filled in: 1. Row names, \"TRUE\" or \"FALSE\" diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index e6aa97e0080..9360562b095 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -182,7 +182,7 @@ attachment folders based on ID." :type '(repeat (function :tag "Function with ID as input"))) (defvar org-attach-after-change-hook nil - "Hook to be called when files have been added or removed to the attachment folder.") + "Hook called when files have been added or removed to the attachment folder.") (defvar org-attach-open-hook nil "Hook that is invoked by `org-attach-open'. diff --git a/lisp/org/org.el b/lisp/org/org.el index 1f7e434cefd..0d7c6c87fdc 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4112,7 +4112,8 @@ groups carry important information: "Regular expression to match a timestamp time or time range. After a match, the following groups carry important information: 0 the full match -1 date plus weekday, for back referencing to make sure both times are on the same day +1 date plus weekday, for back referencing to make sure + both times are on the same day 2 the first time, range or not 4 the second time, if it is a range.") diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index b7e0c452288..0e515530852 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -682,7 +682,7 @@ otherwise build the summary from TYPE and SYMBOL." (xref-make-elisp-location symbol type file))) (defvar elisp-xref-find-def-functions nil - "List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs. + "List of functions run from `elisp--xref-find-definitions' to add more xrefs. Called with one arg; the symbol whose definition is desired. Each function should return a list of xrefs, or nil; the first non-nil result supersedes the xrefs produced by diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index fbc6e424eb1..8cb0350dc06 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -75,7 +75,7 @@ (defconst ruby-block-mid-re (regexp-opt ruby-block-mid-keywords) - "Regexp to match where the indentation gets shallower in middle of block statements.") + "Regexp for where the indentation gets shallower in middle of block statements.") (defconst ruby-block-op-keywords '("and" "or" "not") diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index b1abefe534e..f6e95b9cb6a 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -10112,7 +10112,8 @@ variables to build the path." ;; A modi is: [module-name-string file-name begin-point] (defvar verilog-cache-enabled t - "Non-nil enables caching of signals, etc. Set to nil for debugging to make things SLOW!") + "Non-nil enables caching of signals, etc. +Set to nil for debugging to make things SLOW!") (defvar verilog-modi-cache-list nil "Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)... diff --git a/lisp/term.el b/lisp/term.el index 2e69af0735b..d73a9b0d01c 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -365,8 +365,8 @@ not allowed.") (defvar-local term-scroll-end nil "Bottom-most line (inclusive) of the scrolling region. `term-scroll-end' must be in the range [0,term-height). In addition, its -value has to be greater than `term-scroll-start', i.e. one line scroll regions are -not allowed.") +value has to be greater than `term-scroll-start', i.e. one line scroll regions +are not allowed.") (defvar term-pager-count nil "Number of lines before we need to page; if nil, paging is disabled.") (defvar term-saved-cursor nil) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index e42615e5158..59d60272aa8 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -853,10 +853,12 @@ simply by any key input." "Timer id for deferred cell update.") (defvar table-inhibit-update nil "Non-nil inhibits implicit cell and cache updates. -It inhibits `table-with-cache-buffer' to update data in both direction, cell to cache and cache to cell.") +It inhibits `table-with-cache-buffer' to update data in both directions, +cell to cache and cache to cell.") (defvar table-inhibit-auto-fill-paragraph nil "Non-nil inhibits auto fill paragraph when `table-with-cache-buffer' exits. -This is always set to nil at the entry to `table-with-cache-buffer' before executing body forms.") +This is always set to nil at the entry to `table-with-cache-buffer' before +executing body forms.") (defvar table-mode-indicator nil "For mode line indicator") ;; This is not a real minor-mode but placed in the minor-mode-alist @@ -957,7 +959,7 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu (describe-bindings . *table--cell-describe-bindings) (dabbrev-expand . *table--cell-dabbrev-expand) (dabbrev-completion . *table--cell-dabbrev-completion)) - "List of cons cells consisting of (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).") + "List of the form (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).") (defvar table-command-list ;; Construct the real contents of the `table-command-list'. diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index ccf5a7807f2..adb6ce80537 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -149,7 +149,7 @@ This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs") (ediff-defvar-local ediff-ignore-similar-regions nil - "If t, skip over difference regions that differ only in the white space and line breaks. + "If t, skip difference regions that differ only in white space and line breaks. This variable can be set either in .emacs or toggled interactively. Use `setq-default' if setting it in .emacs") diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index c68dc718843..3d90ccb1cbb 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -182,7 +182,7 @@ Used internally---not a user option.") ;; not used for now (defvar ediff-mouse-pixel-threshold 30 - "If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window.") + "If mouse moved more than this many pixels, don't warp mouse into control window.") (defcustom ediff-grab-mouse t "If t, Ediff will always grab the mouse and put it in the control frame. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 13f875b1920..5c41761a04b 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -925,7 +925,7 @@ Its behavior has mainly two restrictions: This only matters if `smerge-refine-weight-hack' is nil.") (defvar smerge-refine-ignore-whitespace t - "If non-nil, indicate that `smerge-refine' should try to ignore change in whitespace.") + "If non-nil, `smerge-refine' should try to ignore change in whitespace.") (defvar smerge-refine-weight-hack t "If non-nil, pass to diff as many lines as there are chars in the region. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7d9af00de7c..160016c3e5e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2386,8 +2386,9 @@ This function runs the hook `vc-retrieve-tag-hook' when finished." ;; for the root directory. (defvar vc-log-short-style '(directory) "Whether or not to show a short log. -If it contains `directory' then if the fileset contains a directory show a short log. -If it contains `file' then show short logs for files. +If it contains `directory', show a short log if the fileset +contains a directory. +If it contains `file', show short logs for files. Not all VC backends support short logs!") (defvar log-view-vc-fileset) diff --git a/lisp/view.el b/lisp/view.el index 6f576f8c046..c1b788a7393 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -141,7 +141,8 @@ See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of (put 'view-return-to-alist 'permanent-local t) (defvar view-exit-action nil - "If non-nil, a function with one argument (a buffer) called when finished viewing. + "If non-nil, a function called when finished viewing. +The function should take one argument (a buffer). Commands like \\[view-file] and \\[view-file-other-window] may set this to bury or kill the viewed buffer. Observe that the buffer viewed might not appear in any window at From 34a73666d9559d948815a53b63dc36cc878d5aff Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 19 Dec 2020 17:14:33 +0100 Subject: [PATCH 139/148] Shorten some over-wide docstrings in functions and macros * lisp/allout-widgets.el (allout-widgets-tally-string): * lisp/array.el (array-mode): * lisp/calc/calc-units.el (calc-spn): * lisp/cedet/ede/generic.el (ede-generic-new-autoloader): * lisp/cedet/semantic/analyze.el (semantic-analyze-find-tag-sequence-default) (semantic-analyze-find-tag-sequence): * lisp/cedet/semantic/bovine/c.el (semantic-c-evaluate-symbol-for-hideif): * lisp/cedet/semantic/bovine/make.el (semantic-lex-make-command): * lisp/cedet/semantic/db-typecache.el (semanticdb-typecache-include-tags): * lisp/cedet/semantic/doc.el (semantic-documentation-for-tag): * lisp/cedet/semantic/tag-ls.el (semantic--tag-attribute-similar-p): * lisp/emacs-lisp/advice.el (ad-map-arglists): * lisp/emacs-lisp/bytecomp.el (byte-constant2) (byte-save-restriction, byte-catch-OBSOLETE, byte-unwind-protect): * lisp/emacs-lisp/cl-generic.el (cl-generic-combine-methods): * lisp/emacs-lisp/seq.el (seq-partition, seq-set-equal-p) (seq-filter): * lisp/faces.el (face-attribute-specified-or, face-equal): * lisp/info.el (Info-prev-reference-or-link) (Info-next-reference-or-link): * lisp/isearch.el (with-isearch-suspended): * lisp/kmacro.el (kmacro-step-edit-macro, kmacro-set-counter): * lisp/org/org-agenda.el (org-agenda-filter-by-category): * lisp/ses.el (ses-cell-symbol): * lisp/w32-fns.el (w32-shell-dos-semantics): Shorten doc strings to not exceed 80-column limits. (Bug#44858) --- lisp/allout-widgets.el | 2 +- lisp/array.el | 24 +++++++++++++----------- lisp/calc/calc-units.el | 2 +- lisp/cedet/ede/generic.el | 4 ++-- lisp/cedet/semantic/analyze.el | 6 ++++-- lisp/cedet/semantic/bovine/c.el | 3 ++- lisp/cedet/semantic/bovine/make.el | 3 ++- lisp/cedet/semantic/db-typecache.el | 2 +- lisp/cedet/semantic/doc.el | 2 +- lisp/cedet/semantic/tag-ls.el | 5 +++-- lisp/emacs-lisp/advice.el | 5 +++-- lisp/emacs-lisp/bytecomp.el | 16 ++++++++++------ lisp/emacs-lisp/cl-generic.el | 4 ++-- lisp/emacs-lisp/seq.el | 7 ++++--- lisp/faces.el | 4 ++-- lisp/info.el | 18 +++++++++++------- lisp/isearch.el | 3 ++- lisp/kmacro.el | 6 ++++-- lisp/org/org-agenda.el | 3 ++- lisp/ses.el | 3 ++- lisp/w32-fns.el | 2 +- 21 files changed, 73 insertions(+), 51 deletions(-) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 7e7957762ba..21517aea01c 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -254,7 +254,7 @@ or deleted while this variable is nil.") (defvar allout-widgets-mode-inhibit) ; defined below ;;;_ > allout-widgets-tally-string (defun allout-widgets-tally-string () - "Return a string giving the number of tracked widgets, or empty string if not tracking. + "Return a string with number of tracked widgets, or empty string if not tracking. The string is formed for appending to the allout-mode mode-line lighter. diff --git a/lisp/array.el b/lisp/array.el index 0ad565b5bc7..de2de3ce6cb 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -817,14 +817,16 @@ The variables are: Variables you assign: array-max-row: The number of rows in the array. array-max-column: The number of columns in the array. - array-columns-per-line: The number of columns in the array per line of buffer. + array-columns-per-line: The number of columns in the array + per line of buffer. array-field-width: The width of each field, in characters. array-rows-numbered: A logical variable describing whether to ignore - row numbers in the buffer. + row numbers in the buffer. Variables which are calculated: array-line-length: The number of characters in a buffer line. - array-lines-per-row: The number of buffer lines used to display each row. + array-lines-per-row: The number of buffer lines used to + display each row. The following commands are available (an asterisk indicates it may take a numeric prefix argument): @@ -834,17 +836,17 @@ take a numeric prefix argument): * \\[array-next-row] Move down one row. * \\[array-previous-row] Move up one row. - * \\[array-copy-forward] Copy the current field into the column to the right. - * \\[array-copy-backward] Copy the current field into the column to the left. - * \\[array-copy-down] Copy the current field into the row below. - * \\[array-copy-up] Copy the current field into the row above. + * \\[array-copy-forward] Copy current field into the column to the right. + * \\[array-copy-backward] Copy current field into the column to the left. + * \\[array-copy-down] Copy current field into the row below. + * \\[array-copy-up] Copy current field into the row above. - * \\[array-copy-column-forward] Copy the current column into the column to the right. - * \\[array-copy-column-backward] Copy the current column into the column to the left. + * \\[array-copy-column-forward] Copy current column into the column to the right. + * \\[array-copy-column-backward] Copy current column into the column to the left. * \\[array-copy-row-down] Copy the current row into the row below. * \\[array-copy-row-up] Copy the current row into the row above. - \\[array-fill-rectangle] Copy the field at mark into every cell with row and column + \\[array-fill-rectangle] Copy field at mark into every cell with row and column between that of point and mark. \\[array-what-position] Display the current array row and column. @@ -855,7 +857,7 @@ take a numeric prefix argument): \\[array-expand-rows] Expand the array (remove row numbers and newlines inside rows) - \\[array-display-local-variables] Display the current values of local variables. + \\[array-display-local-variables] Display current values of local variables. Entering array mode calls the function `array-mode-hook'." (make-local-variable 'array-buffer-line) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 742b2bb8728..e2ef6ee6ba6 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -2157,7 +2157,7 @@ If non-nil, return a list consisting of the note and the cents coefficient." (calc-unary-op "midi" 'calcFunc-midi arg))) (defun calc-spn (arg) - "Return the scientific pitch notation corresponding to the expression on the stack." + "Return scientific pitch notation corresponding to the expression on the stack." (interactive "P") (calc-slow-wrapper (calc-unary-op "spn" 'calcFunc-spn arg))) diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index b9805f6fac9..0f202ddfc88 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el @@ -258,8 +258,8 @@ If one doesn't exist, create a new one for this directory." INTERNAL-NAME is obsolete and ignored. EXTERNAL-NAME is a human readable name to describe the project; it must be unique among all autoloaded projects. -PROJECTFILE is a file name that identifies a project of this type to EDE, such as -a Makefile, or SConstruct file. +PROJECTFILE is a file name that identifies a project of this type to EDE, such +as a Makefile, or SConstruct file. CLASS is the EIEIO class that is used to track this project. It should subclass `ede-generic-project'." (ede-add-project-autoload diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index cafdc3bee14..f2d2279c001 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -235,7 +235,8 @@ scoped. These are not local variables, but symbols available in a structure which doesn't need to be dereferenced. Optional argument TYPERETURN is a symbol in which the types of all found will be stored. If nil, that data is thrown away. -Optional argument THROWSYM specifies a symbol the throw on non-recoverable error. +Optional argument THROWSYM specifies a symbol the throw on non-recoverable +error. Remaining arguments FLAGS are additional flags to apply when searching.") (defun semantic-analyze-find-tag-sequence-default @@ -246,7 +247,8 @@ Remaining arguments FLAGS are additional flags to apply when searching.") SCOPE are extra tags which are in scope. TYPERETURN is a symbol in which to place a list of tag classes that are found in SEQUENCE. -Optional argument THROWSYM specifies a symbol the throw on non-recoverable error. +Optional argument THROWSYM specifies a symbol the throw on non-recoverable +error. Remaining arguments FLAGS are additional flags to apply when searching. This function knows of flags: `mustbeclassvariable'" diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 3649d1c2f1f..7f0c16136ce 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -368,7 +368,8 @@ Take the first interesting thing and convert it." (defun semantic-c-evaluate-symbol-for-hideif (spp-symbol) "Lookup the symbol SPP-SYMBOL (a string) to something hideif can use. -Pulls out the symbol list, and call `semantic-c-convert-spp-value-to-hideif-value'." +Pull out the symbol list, and call +`semantic-c-convert-spp-value-to-hideif-value'." (interactive "sSymbol name: ") (when (symbolp spp-symbol) (setq spp-symbol (symbol-name spp-symbol))) diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 07c55b46e26..3ca7dcd48e2 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -50,7 +50,8 @@ nil) (define-lex-regex-analyzer semantic-lex-make-command - "A command in a Makefile consists of a line starting with TAB, and ending at the newline." + "Regexp for a command in a Makefile. +It consists of a line starting with TAB, and ending at the newline." "^\\(\t\\)" (let ((start (match-end 0))) (while (progn (end-of-line) diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 09f0e52e44d..3b6f70ab32a 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -343,7 +343,7 @@ all included files." nil) (cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-table)) - "Update the typecache for TABLE, and return the merged types from the include tags. + "Update typecache for TABLE, and return the merged types from the include tags. Include-tags are the tags brought in via includes, all merged together into a master list." (let* ((cache (semanticdb-get-typecache table)) diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index 896bc3bb42e..e84e99e1e8d 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -40,7 +40,7 @@ TAG might have DOCUMENTATION set in it already. If not, there may be some documentation in a comment preceding TAG's definition which we can look for. When appropriate, this can be overridden by a language specific enhancement. -Optional argument NOSNARF means to only return the lexical analyzer token for it. +Optional argument NOSNARF means return only the lexical analyzer token for it. If NOSNARF is `lex', then only return the lex token." (if (not tag) (setq tag (semantic-current-tag))) (save-excursion diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 3ee11df7d8e..d07e5652484 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -93,8 +93,9 @@ for a given mode at a more granular level. Note that :type, :name, and anything in IGNORABLE-ATTRIBUTES will not be passed to this function. -Modes that override this function can call `semantic--tag-attribute-similar-p-default' -to do the default equality tests if ATTR is not special for that mode.") +Modes that override this function can call +`semantic--tag-attribute-similar-p-default' to do the default equality tests if +ATTR is not special for that mode.") (defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes) "For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity." diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index c8a6676b665..caa436ce234 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2405,8 +2405,9 @@ as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. -Example: (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return - (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))." +Example: + (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return + (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) (nth 1 parsed-source-arglist))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 64f2c010824..7e1a3304cc8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -707,7 +707,8 @@ Each element is (INDEX . VALUE)") ;; These store their argument in the next two bytes (byte-defop 129 1 byte-constant2 - "for reference to a constant with vector index >= byte-constant-limit") + "for reference to a constant with vector +index >= byte-constant-limit") (byte-defop 130 0 byte-goto "for unconditional jump") (byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil") (byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil") @@ -727,11 +728,14 @@ otherwise pop it") (byte-defop 139 0 byte-save-window-excursion-OBSOLETE "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction - "to make a binding to record the current buffer clipping restrictions") + "to make a binding to record the current buffer clipping +restrictions") (byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25. - "for catch. Takes, on stack, the tag and an expression for the body") + "for catch. Takes, on stack, the tag and an expression for +the body") (byte-defop 142 -1 byte-unwind-protect - "for unwind-protect. Takes, on stack, an expression for the unwind-action") + "for unwind-protect. Takes, on stack, an expression for +the unwind-action") ;; For condition-case. Takes, on stack, the variable to bind, ;; an expression for the body, and a list of clauses. @@ -791,8 +795,8 @@ otherwise pop it") (defconst byte-discardN-preserve-tos byte-discardN) (byte-defop 183 -2 byte-switch - "to take a hash table and a value from the stack, and jump to the address -the value maps to, if any.") + "to take a hash table and a value from the stack, and jump to +the address the value maps to, if any.") ;; unused: 182-191 diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index b37b05b9a3a..9ddf9e7333b 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -811,8 +811,8 @@ It should return a function that expects the same arguments as the methods, and GENERIC is the generic function (mostly used for its name). METHODS is the list of the selected methods. The METHODS list is sorted from most specific first to most generic last. -The function can use `cl-generic-call-method' to create functions that call those -methods.") +The function can use `cl-generic-call-method' to create functions that call +those methods.") (unless (ignore-errors (cl-generic-generalizers t)) ;; Temporary definition to let the next defmethod succeed. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4656277ea16..d91a33c1403 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -317,7 +317,7 @@ list." ;;;###autoload (cl-defgeneric seq-filter (pred sequence) - "Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE." + "Return a list of all elements for which (PRED element) is non-nil in SEQUENCE." (let ((exclude (make-symbol "exclude"))) (delq exclude (seq-map (lambda (elt) (if (funcall pred elt) @@ -411,7 +411,8 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." nil)) (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) - "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. + "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements. +This does not depend on the order of the elements. Equality is defined by TESTFN if non-nil or by `equal' if nil." (and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1) (seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2))) @@ -444,7 +445,7 @@ The result is a sequence of type TYPE, or a list if TYPE is nil." (seq-map function sequence))) (cl-defgeneric seq-partition (sequence n) - "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N. + "Return list of elements of SEQUENCE grouped into sub-sequences of length N. The last sequence may contain less than N elements. If N is a negative integer or 0, nil is returned." (unless (< n 1) diff --git a/lisp/faces.el b/lisp/faces.el index 7355e1dd0a5..d0307fe173d 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -272,7 +272,7 @@ of a face name is the same for all frames." (defun face-equal (face1 face2 &optional frame) "Non-nil if faces FACE1 and FACE2 are equal. Faces are considered equal if all their attributes are equal. -If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame. +If optional argument FRAME is given, report on FACE1 and FACE2 in that frame. If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames). If FRAME is omitted or nil, use the selected frame." (internal-lisp-face-equal-p face1 face2 frame)) @@ -484,7 +484,7 @@ FACES may be either a single face or a list of faces. (defmacro face-attribute-specified-or (value &rest body) - "Return VALUE, unless it's `unspecified', in which case evaluate BODY and return the result." + "Return VALUE or, if it's `unspecified', the result of evaluating BODY." (let ((temp (make-symbol "value"))) `(let ((,temp ,value)) (if (not (eq ,temp 'unspecified)) diff --git a/lisp/info.el b/lisp/info.el index c049aa88a5d..efaf440d191 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3105,9 +3105,11 @@ See `Info-scroll-down'." (defun Info-next-reference-or-link (pat prop) "Move point to the next pattern-based cross-reference or property-based link. The next cross-reference is searched using the regexp PAT, and the next link -is searched using the text property PROP. Move point to the closest found position -of either a cross-reference found by `re-search-forward' or a link found by -`next-single-char-property-change'. Return the new position of point, or nil." +is searched using the text property PROP. Move point to the closest found +position of either a cross-reference found by `re-search-forward' or a link +found by `next-single-char-property-change'. + +Return the new position of point, or nil." (let ((pxref (save-excursion (re-search-forward pat nil t))) (plink (next-single-char-property-change (point) prop))) (when (and (< plink (point-max)) (not (get-char-property plink prop))) @@ -3120,10 +3122,12 @@ of either a cross-reference found by `re-search-forward' or a link found by (defun Info-prev-reference-or-link (pat prop) "Move point to the previous pattern-based cross-reference or property-based link. -The previous cross-reference is searched using the regexp PAT, and the previous link -is searched using the text property PROP. Move point to the closest found position -of either a cross-reference found by `re-search-backward' or a link found by -`previous-single-char-property-change'. Return the new position of point, or nil." +The previous cross-reference is searched using the regexp PAT, and the previous +link is searched using the text property PROP. Move point to the closest found +position of either a cross-reference found by `re-search-backward' or a link +found by `previous-single-char-property-change'. + +Return the new position of point, or nil." (let ((pxref (save-excursion (re-search-backward pat nil t))) (plink (previous-single-char-property-change (point) prop))) (when (and (> plink (point-min)) (not (get-char-property plink prop))) diff --git a/lisp/isearch.el b/lisp/isearch.el index 0d5c480c8d4..13173a28579 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1603,7 +1603,8 @@ If this is set inside code wrapped by the macro "Exit Isearch mode, run BODY, and reinvoke the pending search. You can update the global isearch variables by setting new values to `isearch-new-string', `isearch-new-message', `isearch-new-forward', -`isearch-new-regexp-function', `isearch-new-case-fold', `isearch-new-nonincremental'." +`isearch-new-regexp-function', `isearch-new-case-fold', +`isearch-new-nonincremental'." ;; This code is very hairy for several reasons, explained in the code. ;; Mainly, isearch-mode must be terminated while editing and then restarted. ;; If there were a way to catch any change of buffer from the minibuffer, diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 3437dba5e6a..17db48c3298 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -289,7 +289,8 @@ the last increment." (defun kmacro-set-counter (arg) "Set the value of `kmacro-counter' to ARG, or prompt for value if no argument. -With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the macro." +With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the +macro." (interactive "NMacro counter value: ") (if (not (or defining-kbd-macro executing-kbd-macro)) (kmacro-display-counter (setq kmacro-initial-counter-value arg)) @@ -1272,7 +1273,8 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (defun kmacro-step-edit-macro () "Step edit and execute last keyboard macro. -To customize possible responses, change the \"bindings\" in `kmacro-step-edit-map'." +To customize possible responses, change the \"bindings\" in +`kmacro-step-edit-map'." (interactive) (let ((kmacro-step-edit-active t) (kmacro-step-edit-new-macro "") diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 5a2ba027f97..cd63b0ebefa 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -7558,7 +7558,8 @@ With a prefix argument, do so in all agenda buffers." "Filter lines in the agenda buffer that have a specific category. The category is that of the current line. With a `\\[universal-argument]' prefix argument, exclude the lines of that category. -When there is already a category filter in place, this command removes the filter." +When there is already a category filter in place, this command removes the +filter." (interactive "P") (if (and org-agenda-filtered-by-category org-agenda-category-filter) diff --git a/lisp/ses.el b/lisp/ses.el index bfafc132bf5..2a28ad3add7 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -430,7 +430,8 @@ when to emit a progress message.") local-printer-list) (defmacro ses-cell-symbol (row &optional col) - "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." + "Return symbol of the local-variable holding value of CELL or pair (ROW,COL). +For example, (0,0) => A1." (declare (debug t)) `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row))) (put 'ses-cell-symbol 'safe-function t) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index e159d1888e5..f1dcc54043d 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -55,7 +55,7 @@ w32-system-shells))) (defun w32-shell-dos-semantics () - "Return non-nil if the interactive shell being used expects MS-DOS shell semantics." + "Return non-nil if current interactive shell expects MS-DOS shell semantics." (or (w32-system-shell-p (w32-shell-name)) (and (member (downcase (file-name-nondirectory (w32-shell-name))) '("cmdproxy" "cmdproxy.exe")) From 7c3d3b83358842857a0af99b89983cfa9a5512a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 19 Dec 2020 19:54:46 +0100 Subject: [PATCH 140/148] Convert apropos-internal from C to Lisp (Bug#44529) This runs insignificantly faster in C, and is already fast enough on reasonably modern hardware. We might as well lift it to Lisp. This benchmark can be used to verify: (benchmark-run 10 (apropos-command "test")) => (0.12032415399999999 2 0.014772391999999995) ; C => (0.13513192100000002 2 0.017216643000000004) ; Lisp * lisp/subr.el (apropos-internal): New defun, converted from C. * src/keymap.c (Fapropos_internal): Remove defun. (apropos_accum): Remove function. (apropos_predicate, apropos_accumulate): Remove variables. (syms_of_keymap): Remove defsubr for Fapropos_internal, and definitions of the above variables. * test/src/keymap-tests.el (keymap-apropos-internal) (keymap-apropos-internal/predicate): Move tests from here... * test/lisp/subr-tests.el (apropos-apropos-internal) (apropos-apropos-internal/predicate): ...to here. --- lisp/subr.el | 16 ++++++++++++++++ src/keymap.c | 39 --------------------------------------- test/lisp/subr-tests.el | 12 ++++++++++++ test/src/keymap-tests.el | 13 ------------- 4 files changed, 28 insertions(+), 52 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 77c19c5bbf3..1b2d778454e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5845,6 +5845,22 @@ This is the simplest safe way to acquire and release a mutex." (progn ,@body) (mutex-unlock ,sym))))) + +;;; Apropos. + +(defun apropos-internal (regexp &optional predicate) + "Show all symbols whose names contain match for REGEXP. +If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done +for each symbol and a symbol is mentioned only if that returns non-nil. +Return list of symbols found." + (let (found) + (mapatoms (lambda (symbol) + (when (and (string-match regexp (symbol-name symbol)) + (or (not predicate) + (funcall predicate symbol))) + (push symbol found)))) + (sort found #'string-lessp))) + ;;; Misc. diff --git a/src/keymap.c b/src/keymap.c index e22eb411f63..ca2d33dba47 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -3243,49 +3243,11 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, } } -/* Apropos - finding all symbols whose names match a regexp. */ -static Lisp_Object apropos_predicate; -static Lisp_Object apropos_accumulate; - -static void -apropos_accum (Lisp_Object symbol, Lisp_Object string) -{ - register Lisp_Object tem; - - tem = Fstring_match (string, Fsymbol_name (symbol), Qnil); - if (!NILP (tem) && !NILP (apropos_predicate)) - tem = call1 (apropos_predicate, symbol); - if (!NILP (tem)) - apropos_accumulate = Fcons (symbol, apropos_accumulate); -} - -DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, - doc: /* Show all symbols whose names contain match for REGEXP. -If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done -for each symbol and a symbol is mentioned only if that returns non-nil. -Return list of symbols found. */) - (Lisp_Object regexp, Lisp_Object predicate) -{ - Lisp_Object tem; - CHECK_STRING (regexp); - apropos_predicate = predicate; - apropos_accumulate = Qnil; - map_obarray (Vobarray, apropos_accum, regexp); - tem = Fsort (apropos_accumulate, Qstring_lessp); - apropos_accumulate = Qnil; - apropos_predicate = Qnil; - return tem; -} - void syms_of_keymap (void) { DEFSYM (Qkeymap, "keymap"); DEFSYM (Qdescribe_map_tree, "describe-map-tree"); - staticpro (&apropos_predicate); - staticpro (&apropos_accumulate); - apropos_predicate = Qnil; - apropos_accumulate = Qnil; DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize"); @@ -3429,7 +3391,6 @@ be preferred. */); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_buffer_bindings); - defsubr (&Sapropos_internal); } void diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index e275e4b1c89..25da19574a9 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -597,6 +597,18 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (undo-boundary) (undo) (should (equal (buffer-string) "")))) + +;;; Apropos. + +(ert-deftest apropos-apropos-internal () + (should (equal (apropos-internal "^next-line$") '(next-line))) + (should (>= (length (apropos-internal "^help")) 100)) + (should-not (apropos-internal "^test-a-missing-symbol-foo-bar-zot$"))) + +(ert-deftest apropos-apropos-internal/predicate () + (should (equal (apropos-internal "^next-line$" #'commandp) '(next-line))) + (should (>= (length (apropos-internal "^help" #'commandp)) 15)) + (should-not (apropos-internal "^next-line$" #'keymapp))) (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 6411cd1f0d4..f58dac87401 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -248,19 +248,6 @@ g .. h foo 0 .. 3 foo "))))) - -;;;; apropos-internal - -(ert-deftest keymap-apropos-internal () - (should (equal (apropos-internal "^next-line$") '(next-line))) - (should (>= (length (apropos-internal "^help")) 100)) - (should-not (apropos-internal "^test-a-missing-symbol-foo-bar-zut$"))) - -(ert-deftest keymap-apropos-internal/predicate () - (should (equal (apropos-internal "^next-line$" #'commandp) '(next-line))) - (should (>= (length (apropos-internal "^help" #'commandp)) 15)) - (should-not (apropos-internal "^next-line$" #'keymapp))) - (provide 'keymap-tests) ;;; keymap-tests.el ends here From 5fe04f6b0773279a46b0449f0c890af3a03fb649 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 19 Dec 2020 22:12:32 +0200 Subject: [PATCH 141/148] No need to set isearch-input-method-function in isearch-transient-input-method --- lisp/international/isearch-x.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el index 867a3d86973..1f5f8b7e32a 100644 --- a/lisp/international/isearch-x.el +++ b/lisp/international/isearch-x.el @@ -55,7 +55,6 @@ (interactive) (let ((overriding-terminal-local-map nil)) (activate-transient-input-method)) - (setq isearch-input-method-function input-method-function) (setq-local input-method-function nil) (isearch-update)) From b9edbaed01a91d5fc6235fc679d8e0cd827f6fa9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 19 Dec 2020 22:19:18 +0200 Subject: [PATCH 142/148] * lisp/image-mode.el: Use one timer and lock for slow remote calls (bug#45256) * lisp/image-mode.el (image-auto-resize-timer): New variable. (image--window-state-change): Cancel previous timer and remember new timer in image-auto-resize-timer. (image--window-state-change): New variable. (image-fit-to-window): When image-fit-to-window-lock is nil, call image-toggle-display-image ignoring 'remote-file-error'. --- lisp/image-mode.el | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 032ebf38733..465bf867627 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -942,6 +942,9 @@ Otherwise, display the image by calling `image-mode'." (get-buffer-window-list (current-buffer) 'nomini 'visible)) (image-toggle-display-image))) +(defvar image-auto-resize-timer nil + "Timer for `image-auto-resize-on-window-resize' option.") + (defun image--window-state-change (window) ;; Wait for a bit of idle-time before actually performing the change, ;; so as to batch together sequences of closely consecutive size changes. @@ -950,8 +953,14 @@ Otherwise, display the image by calling `image-mode'." ;; consecutive calls happen without any redisplay between them, ;; the costly operation of image resizing should happen only once. (when (numberp image-auto-resize-on-window-resize) - (run-with-idle-timer image-auto-resize-on-window-resize nil - #'image-fit-to-window window))) + (when image-auto-resize-timer + (cancel-timer image-auto-resize-timer)) + (setq image-auto-resize-timer + (run-with-idle-timer image-auto-resize-on-window-resize nil + #'image-fit-to-window window)))) + +(defvar image-fit-to-window-lock nil + "Lock for `image-fit-to-window' timer function.") (defun image-fit-to-window (window) "Adjust size of image to display it exactly in WINDOW boundaries." @@ -968,7 +977,13 @@ Otherwise, display the image by calling `image-mode'." (when (and image-width image-height (or (not (= image-width window-width)) (not (= image-height window-height)))) - (image-toggle-display-image))))))))) + (unless image-fit-to-window-lock + (unwind-protect + (progn + (setq-local image-fit-to-window-lock t) + (ignore-error 'remote-file-error + (image-toggle-display-image))) + (setq image-fit-to-window-lock nil))))))))))) ;;; Animated images From 32e781b2f1e2cbf2bed323247b13dca3ed53fc71 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 20 Dec 2020 00:16:32 +0200 Subject: [PATCH 143/148] Jamie Beardslee * lisp/progmodes/project.el (project-execute-extended-command): New command. (project-prefix-map): Binding for it. Copyright-paperwork-exempt: yes --- lisp/progmodes/project.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d786c3f967a..5b58090de02 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -631,6 +631,7 @@ DIRS must contain directory names." (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) + (define-key map "x" 'project-execute-extended-command) map) "Keymap for project commands.") @@ -1246,6 +1247,14 @@ It's also possible to enter an arbitrary directory not in the list." (project--ensure-read-project-list) (mapcar #'car project--list)) +;;;###autoload +(defun project-execute-extended-command () + "Execute an extended command in project root." + (declare (interactive-only command-execute)) + (interactive) + (let ((default-directory (project-root (project-current t)))) + (call-interactively #'execute-extended-command))) + ;;; Project switching From 87b82a1969edf80d3bd4781454ec9fc968773a6d Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 19 Dec 2020 15:25:14 -0800 Subject: [PATCH 144/148] Fix default value of gnus-registry-register-all: should be t * lisp/gnus/gnus-registry.el (gnus-registry-register-all): This was meant to default to t; only an oversight during code review left it as nil. --- lisp/gnus/gnus-registry.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 31aee0364cf..72412595a9a 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -163,7 +163,7 @@ nnmairix groups are specifically excluded because they are ephemeral." (const :tag "Always Install" t) (const :tag "Ask Me" ask))) -(defcustom gnus-registry-register-all nil +(defcustom gnus-registry-register-all t "If non-nil, register all articles in the registry." :type 'boolean :version "28.1") @@ -1094,7 +1094,7 @@ only the last one's marks are returned." (defun gnus-registry-get-or-make-entry (id &optional no-create) "Return registry entry for ID. -If entry is not found, create a new one, unless NO-create is +If entry is not found, create a new one, unless NO-CREATE is non-nil." (let* ((db gnus-registry-db) ;; safe if not found From 409a9dbe9da64b4d75fec1f511e168c94e60e35b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 19 Dec 2020 16:47:32 +0100 Subject: [PATCH 145/148] image-cache-size improvements Implement for non-Cairo X11 and NS. Count masks as well, and XImage objects on X11. * src/image.c (image_size_in_bytes): New. (image_frame_cache_size): Use image_size_in_bytes. * src/nsterm.h: * src/nsimage.m (ns_image_size_in_bytes, [EmacsImage sizeInBytes]): New function and method. * src/w32gui.h: * src/w32term.c (w32_image_size): Update signature. --- src/image.c | 72 ++++++++++++++++++++++++++++++++++----------------- src/nsimage.m | 22 ++++++++++++++++ src/nsterm.h | 2 ++ src/w32gui.h | 2 +- src/w32term.c | 4 +-- 5 files changed, 75 insertions(+), 27 deletions(-) diff --git a/src/image.c b/src/image.c index dc06e9ce208..d0ae44e7df7 100644 --- a/src/image.c +++ b/src/image.c @@ -1792,38 +1792,62 @@ which is then usually a filename. */) return Qnil; } +static size_t +image_size_in_bytes (struct image *img) +{ + size_t size = 0; + +#if defined USE_CAIRO + Emacs_Pixmap pm = img->pixmap; + if (pm) + size += pm->height * pm->bytes_per_line; + Emacs_Pixmap msk = img->mask; + if (msk) + size += msk->height * msk->bytes_per_line; + +#elif defined HAVE_X_WINDOWS + /* Use a nominal depth of 24 bpp for pixmap and 1 bpp for mask, + to avoid having to query the server. */ + if (img->pixmap != NO_PIXMAP) + size += img->width * img->height * 3; + if (img->mask != NO_PIXMAP) + size += img->width * img->height / 8; + + if (img->ximg && img->ximg->data) + size += img->ximg->bytes_per_line * img->ximg->height; + if (img->mask_img && img->mask_img->data) + size += img->mask_img->bytes_per_line * img->mask_img->height; + +#elif defined HAVE_NS + if (img->pixmap) + size += ns_image_size_in_bytes (img->pixmap); + if (img->mask) + size += ns_image_size_in_bytes (img->mask); + +#elif defined HAVE_NTGUI + if (img->pixmap) + size += w32_image_size (img->pixmap); + if (img->mask) + size += w32_image_size (img->mask); + +#endif + + return size; +} + static size_t image_frame_cache_size (struct frame *f) { + struct image_cache *c = FRAME_IMAGE_CACHE (f); + if (!c) + return 0; + size_t total = 0; -#if defined USE_CAIRO - struct image_cache *c = FRAME_IMAGE_CACHE (f); - - if (!c) - return 0; - for (ptrdiff_t i = 0; i < c->used; ++i) { struct image *img = c->images[i]; - - if (img && img->pixmap && img->pixmap != NO_PIXMAP) - total += img->pixmap->width * img->pixmap->height * - img->pixmap->bits_per_pixel / 8; + total += img ? image_size_in_bytes (img) : 0; } -#elif defined HAVE_NTGUI - struct image_cache *c = FRAME_IMAGE_CACHE (f); - - if (!c) - return 0; - - for (ptrdiff_t i = 0; i < c->used; ++i) - { - struct image *img = c->images[i]; - - if (img && img->pixmap && img->pixmap != NO_PIXMAP) - total += w32_image_size (img); - } -#endif return total; } diff --git a/src/nsimage.m b/src/nsimage.m index da6f01cf6a3..f9fb368ba80 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -235,6 +235,11 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) [(EmacsImage *)img setAlphaAtX: x Y: y to: a]; } +size_t +ns_image_size_in_bytes (void *img) +{ + return [(EmacsImage *)img sizeInBytes]; +} /* ========================================================================== @@ -610,5 +615,22 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) smoothing = s; } +/* Approximate allocated size of image in bytes. */ +- (size_t) sizeInBytes +{ + size_t bytes = 0; + NSImageRep *rep; + NSEnumerator *reps = [[self representations] objectEnumerator]; + while ((rep = (NSImageRep *) [reps nextObject])) + { + if ([rep respondsToSelector: @selector (bytesPerRow)]) + { + NSBitmapImageRep *bmr = (NSBitmapImageRep *) rep; + bytes += [bmr bytesPerRow] * [bmr numberOfPlanes] * [bmr pixelsHigh]; + } + } + return bytes; +} + @end diff --git a/src/nsterm.h b/src/nsterm.h index f292993d8f7..94472ec1070 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -666,6 +666,7 @@ typedef id instancetype; - (BOOL)setFrame: (unsigned int) index; - (void)setTransform: (double[3][3]) m; - (void)setSmoothing: (BOOL)s; +- (size_t)sizeInBytes; @end @@ -1195,6 +1196,7 @@ extern void ns_set_alpha (void *img, int x, int y, unsigned char a); extern int ns_display_pixel_height (struct ns_display_info *); extern int ns_display_pixel_width (struct ns_display_info *); +extern size_t ns_image_size_in_bytes (void *img); /* This in nsterm.m */ extern float ns_antialias_threshold; diff --git a/src/w32gui.h b/src/w32gui.h index fc8131130fb..f6cfa9fb87e 100644 --- a/src/w32gui.h +++ b/src/w32gui.h @@ -46,7 +46,7 @@ extern int w32_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data); extern bool w32_can_use_native_image_api (Lisp_Object); extern void w32_gdiplus_shutdown (void); -extern size_t w32_image_size (struct image *); +extern size_t w32_image_size (Emacs_Pixmap); #define FACE_DEFAULT (~0) diff --git a/src/w32term.c b/src/w32term.c index a038e4593f4..989b056ff2e 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1992,12 +1992,12 @@ w32_draw_image_foreground (struct glyph_string *s) } size_t -w32_image_size (struct image *img) +w32_image_size (Emacs_Pixmap pixmap) { BITMAP bm_info; size_t rv = 0; - if (GetObject (img->pixmap, sizeof (BITMAP), &bm_info)) + if (GetObject (pixmap, sizeof (BITMAP), &bm_info)) rv = bm_info.bmWidth * bm_info.bmHeight * bm_info.bmBitsPixel / 8; return rv; } From 1a0a11f7d2d1dbecb9f754b1e129d50e489058e6 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 19 Dec 2020 12:39:45 +0000 Subject: [PATCH 146/148] Inhibit buffer hooks in temporary buffers Give get-buffer-create an optional argument to inhibit buffer hooks in internal or temporary buffers for efficiency (bug#34765). * etc/NEWS: Announce new parameter of get-buffer-create and generate-new-buffer, and that with-temp-buffer and with-temp-file now inhibit buffer hooks. * doc/lispref/buffers.texi (Buffer Names): Fix typo. (Creating Buffers): Document new parameter of get-buffer-create and generate-new-buffer. (Buffer List, Killing Buffers): Document when buffer hooks are inhibited. (Current Buffer): * doc/lispref/files.texi (Writing to Files): Document that with-temp-buffer and with-temp-file inhibit buffer hooks. * doc/lispref/internals.texi (Buffer Internals): Document inhibit_buffer_hooks flag. Remove stale comment. * doc/misc/gnus-faq.texi (FAQ 5-8): * lisp/simple.el (shell-command-on-region): Fix indentation. * lisp/files.el (kill-buffer-hook): Document when hook is inhibited. (create-file-buffer): * lisp/gnus/gnus-uu.el (gnus-uu-unshar-article): * lisp/international/mule.el (load-with-code-conversion): * lisp/mh-e/mh-xface.el (mh-x-image-url-fetch-image): * lisp/net/imap.el (imap-open): * lisp/net/mailcap.el (mailcap-maybe-eval): * lisp/progmodes/flymake-proc.el (flymake-proc--read-file-to-temp-buffer) (flymake-proc--copy-buffer-to-temp-buffer): Simplify. * lisp/subr.el (generate-new-buffer): Forward new optional argument to inhibit buffer hooks to get-buffer-create. (with-temp-file, with-temp-buffer, with-output-to-string): * lisp/json.el (json-encode-string): Inhibit buffer hooks in buffer used. * src/buffer.c (run_buffer_list_update_hook): New helper function. (Fget_buffer_create): Use it. Add optional argument to set inhibit_buffer_hooks flag instead of comparing the buffer name to Vcode_conversion_workbuf_name. All callers changed. (Fmake_indirect_buffer, Frename_buffer, Fbury_buffer_internal) (record_buffer): Use run_buffer_list_update_hook. (Fkill_buffer): Document when buffer hooks are inhibited. Use run_buffer_list_update_hook. (init_buffer_once): Inhibit buffer hooks in Vprin1_to_string_buffer. (Vkill_buffer_query_functions, Vbuffer_list_update_hook): Document when hooks are inhibited. * src/buffer.h (struct buffer): Update inhibit_buffer_hooks commentary. * src/coding.h (Vcode_conversion_workbuf_name): * src/coding.c (Vcode_conversion_workbuf_name): Make static again since it is no longer needed in src/buffer.c. (code_conversion_restore, code_conversion_save, syms_of_coding): Prefer boolean over integer constants. * src/fileio.c (Finsert_file_contents): Inhibit buffer hooks in " *code-converting-work*" buffer. * src/window.c (Fselect_window): Fix grammar. Mention window-selection-change-functions alongside buffer-list-update-hook. * test/src/buffer-tests.el: Fix requires. (buffer-tests-inhibit-buffer-hooks): New test. --- doc/lispref/buffers.texi | 59 +++++++++++++++++------ doc/lispref/files.texi | 7 ++- doc/lispref/internals.texi | 11 ++++- doc/misc/gnus-faq.texi | 8 ++-- etc/NEWS | 16 +++++++ lisp/files.el | 6 ++- lisp/gnus/gnus-uu.el | 3 +- lisp/international/mule.el | 9 ++-- lisp/json.el | 2 +- lisp/mh-e/mh-xface.el | 3 +- lisp/net/imap.el | 3 +- lisp/net/mailcap.el | 3 +- lisp/progmodes/flymake-proc.el | 13 +++-- lisp/simple.el | 3 +- lisp/subr.el | 17 ++++--- src/buffer.c | 88 +++++++++++++++++++--------------- src/buffer.h | 10 ++-- src/callproc.c | 5 +- src/coding.c | 12 ++--- src/coding.h | 3 -- src/fileio.c | 2 +- src/minibuf.c | 2 +- src/print.c | 2 +- src/process.c | 12 ++--- src/w32fns.c | 2 +- src/window.c | 7 +-- src/xdisp.c | 4 +- src/xfns.c | 2 +- src/xwidget.c | 3 +- test/src/buffer-tests.el | 33 +++++++++++-- 30 files changed, 221 insertions(+), 129 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 28603436284..33eb23984dd 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -225,13 +225,22 @@ current buffer is restored even in case of an abnormal exit via @defmac with-temp-buffer body@dots{} @anchor{Definition of with-temp-buffer} -The @code{with-temp-buffer} macro evaluates the @var{body} forms -with a temporary buffer as the current buffer. It saves the identity of +The @code{with-temp-buffer} macro evaluates the @var{body} forms with +a temporary buffer as the current buffer. It saves the identity of the current buffer, creates a temporary buffer and makes it current, evaluates the @var{body} forms, and finally restores the previous -current buffer while killing the temporary buffer. By default, undo -information (@pxref{Undo}) is not recorded in the buffer created by -this macro (but @var{body} can enable that, if needed). +current buffer while killing the temporary buffer. + +@cindex undo in temporary buffers +@cindex @code{kill-buffer-hook} in temporary buffers +@cindex @code{kill-buffer-query-functions} in temporary buffers +@cindex @code{buffer-list-update-hook} in temporary buffers +By default, undo information (@pxref{Undo}) is not recorded in the +buffer created by this macro (but @var{body} can enable that, if +needed). The temporary buffer also does not run the hooks +@code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). The return value is the value of the last form in @var{body}. You can return the contents of the temporary buffer by using @@ -345,9 +354,9 @@ incrementing the number until it is not the name of an existing buffer. If the optional second argument @var{ignore} is non-@code{nil}, it should be a string, a potential buffer name. It means to consider -that potential buffer acceptable, if it is tried, even it is the name -of an existing buffer (which would normally be rejected). Thus, if -buffers named @samp{foo}, @samp{foo<2>}, @samp{foo<3>} and +that potential buffer acceptable, if it is tried, even if it is the +name of an existing buffer (which would normally be rejected). Thus, +if buffers named @samp{foo}, @samp{foo<2>}, @samp{foo<3>} and @samp{foo<4>} exist, @example @@ -932,13 +941,17 @@ window. @defvar buffer-list-update-hook This is a normal hook run whenever the buffer list changes. Functions (implicitly) running this hook are @code{get-buffer-create} -(@pxref{Creating Buffers}), @code{rename-buffer} (@pxref{Buffer Names}), -@code{kill-buffer} (@pxref{Killing Buffers}), @code{bury-buffer} (see -above) and @code{select-window} (@pxref{Selecting Windows}). +(@pxref{Creating Buffers}), @code{rename-buffer} (@pxref{Buffer +Names}), @code{kill-buffer} (@pxref{Killing Buffers}), +@code{bury-buffer} (see above), and @code{select-window} +(@pxref{Selecting Windows}). This hook is not run for internal or +temporary buffers created by @code{get-buffer-create} or +@code{generate-new-buffer} with a non-@code{nil} argument +@var{inhibit-buffer-hooks}. Functions run by this hook should avoid calling @code{select-window} -with a nil @var{norecord} argument or @code{with-temp-buffer} since -either may lead to infinite recursion. +with a @code{nil} @var{norecord} argument since this may lead to +infinite recursion. @end defvar @node Creating Buffers @@ -951,12 +964,20 @@ either may lead to infinite recursion. with the specified name; @code{generate-new-buffer} always creates a new buffer and gives it a unique name. + Both functions accept an optional argument @var{inhibit-buffer-hooks}. +If it is non-@code{nil}, the buffer they create does not run the hooks +@code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). This avoids slowing down internal or temporary +buffers that are never presented to users or passed on to other +applications. + Other functions you can use to create buffers include @code{with-output-to-temp-buffer} (@pxref{Temporary Displays}) and @code{create-file-buffer} (@pxref{Visiting Files}). Starting a subprocess can also create a buffer (@pxref{Processes}). -@defun get-buffer-create buffer-or-name +@defun get-buffer-create buffer-or-name &optional inhibit-buffer-hooks This function returns a buffer named @var{buffer-or-name}. The buffer returned does not become the current buffer---this function does not change which buffer is current. @@ -980,7 +1001,7 @@ level; see @ref{Auto Major Mode}.) If the name begins with a space, the buffer initially disables undo information recording (@pxref{Undo}). @end defun -@defun generate-new-buffer name +@defun generate-new-buffer name &optional inhibit-buffer-hooks This function returns a newly created, empty buffer, but does not make it current. The name of the buffer is generated by passing @var{name} to the function @code{generate-new-buffer-name} (@pxref{Buffer @@ -1092,6 +1113,10 @@ with no arguments. The buffer being killed is the current buffer when they are called. The idea of this feature is that these functions will ask for confirmation from the user. If any of them returns @code{nil}, @code{kill-buffer} spares the buffer's life. + +This hook is not run for internal or temporary buffers created by +@code{get-buffer-create} or @code{generate-new-buffer} with a +non-@code{nil} argument @var{inhibit-buffer-hooks}. @end defvar @defvar kill-buffer-hook @@ -1100,6 +1125,10 @@ questions it is going to ask, just before actually killing the buffer. The buffer to be killed is current when the hook functions run. @xref{Hooks}. This variable is a permanent local, so its local binding is not cleared by changing major modes. + +This hook is not run for internal or temporary buffers created by +@code{get-buffer-create} or @code{generate-new-buffer} with a +non-@code{nil} argument @var{inhibit-buffer-hooks}. @end defvar @defopt buffer-offer-save diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d49ac42bb46..6949ca29c6e 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -701,8 +701,11 @@ in @var{body}. The current buffer is restored even in case of an abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}). -See also @code{with-temp-buffer} in @ref{Definition of -with-temp-buffer,, The Current Buffer}. +Like @code{with-temp-buffer} (@pxref{Definition of with-temp-buffer,, +Current Buffer}), the temporary buffer used by this macro does not run +the hooks @code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). @end defmac @node File Locks diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index fa3dacbb7ae..0adbef33cac 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -2391,6 +2391,15 @@ This flag indicates that narrowing has changed in the buffer. This flag indicates that redisplay optimizations should not be used to display this buffer. +@item inhibit_buffer_hooks +This flag indicates that the buffer should not run the hooks +@code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). It is set at buffer creation (@pxref{Creating +Buffers}), and avoids slowing down internal or temporary buffers, such +as those created by @code{with-temp-buffer} (@pxref{Definition of +with-temp-buffer,, Current Buffer}). + @item overlay_center This field holds the current overlay center position. @xref{Managing Overlays}. @@ -2404,8 +2413,6 @@ after the current overlay center. @xref{Managing Overlays}. and @code{overlays_after} is sorted in order of increasing beginning position. -@c FIXME? the following are now all Lisp_Object BUFFER_INTERNAL_FIELD (foo). - @item name A Lisp string that names the buffer. It is guaranteed to be unique. @xref{Buffer Names}. This and the following fields have their names diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index adb812f5728..c30e80ff565 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -1523,10 +1523,10 @@ Now you only have to tell Gnus to include the X-face in your postings by saying @example (setq message-default-headers - (with-temp-buffer - (insert "X-Face: ") - (insert-file-contents "~/.xface") - (buffer-string))) + (with-temp-buffer + (insert "X-Face: ") + (insert-file-contents "~/.xface") + (buffer-string))) @end example @noindent diff --git a/etc/NEWS b/etc/NEWS index 4a8e70e6a62..1b4c21cb450 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1821,6 +1821,13 @@ modifies the string's text properties; instead, it uses and returns a copy of the string. This helps avoid trouble when strings are shared or constants. ++++ +** Temporary buffers no longer run certain buffer hooks. +The macros 'with-temp-buffer' and 'with-temp-file' no longer run the +hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and +'buffer-list-update-hook' for the temporary buffers they create. This +avoids slowing them down when a lot of these hooks are defined. + --- ** The obsolete function 'thread-alive-p' has been removed. @@ -2177,6 +2184,15 @@ Until it is solved you could ignore such errors by performing ** The error 'ftp-error' belongs also to category 'remote-file-error'. ++++ +** Buffers can now be created with certain hooks disabled. +The functions 'get-buffer-create' and 'generate-new-buffer' accept a +new optional argument 'inhibit-buffer-hooks'. If non-nil, the new +buffer does not run the hooks 'kill-buffer-hook', +'kill-buffer-query-functions', and 'buffer-list-update-hook'. This +avoids slowing down internal or temporary buffers that are never +presented to users or passed on to other applications. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/files.el b/lisp/files.el index 093b5f92e58..70d451cccfa 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1850,6 +1850,10 @@ expand wildcards (if any) and replace the file with multiple files." The buffer being killed is current while the hook is running. See `kill-buffer'. +This hook is not run for internal or temporary buffers created by +`get-buffer-create' or `generate-new-buffer' with argument +INHIBIT-BUFFER-HOOKS non-nil. + Note: Be careful with let-binding this hook considering it is frequently used for cleanup.") @@ -1951,7 +1955,7 @@ this function prepends a \"|\" to the final result if necessary." (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) - (generate-new-buffer (if (string-match-p "\\` " lastname) + (generate-new-buffer (if (string-prefix-p " " lastname) (concat "|" lastname) lastname)))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 5980051ee45..db01fb13527 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1587,8 +1587,7 @@ Gnus might fail to display all of it.") (save-excursion (switch-to-buffer (current-buffer)) (delete-other-windows) - (let ((buffer (get-buffer-create (generate-new-buffer-name - "*Warning*")))) + (let ((buffer (generate-new-buffer "*Warning*"))) (unless (unwind-protect (with-current-buffer buffer diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 212e7232b49..6571454dffe 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -307,12 +307,9 @@ Return t if file exists." (and (null noerror) (signal 'file-error (list "Cannot open load file" file))) ;; Read file with code conversion, and then eval. - (let* ((buffer - ;; We can't use `generate-new-buffer' because files.el - ;; is not yet loaded. - (get-buffer-create (generate-new-buffer-name " *load*"))) - (load-in-progress t) - (source (save-match-data (string-match "\\.el\\'" fullname)))) + (let ((buffer (generate-new-buffer " *load*")) + (load-in-progress t) + (source (string-suffix-p ".el" fullname))) (unless nomessage (if source (message "Loading %s (source)..." file) diff --git a/lisp/json.el b/lisp/json.el index c2fc1574faa..5f512b94cdc 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -435,7 +435,7 @@ Initialized lazily by `json-encode-string'.") (concat "\"" (substring-no-properties string) "\"") (with-current-buffer (or json--string-buffer - (with-current-buffer (generate-new-buffer " *json-string*") + (with-current-buffer (generate-new-buffer " *json-string*" t) ;; This seems to afford decent performance gains. (setq-local inhibit-modification-hooks t) (setq json--string-buffer (current-buffer)))) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 909f1fe95d9..65039310e7b 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -425,8 +425,7 @@ After the image is fetched, it is stored in CACHE-FILE. It will be displayed in a buffer and position specified by MARKER. The actual display is carried out by the SENTINEL function." (if mh-wget-executable - (let ((buffer (get-buffer-create (generate-new-buffer-name - mh-temp-fetch-buffer))) + (let ((buffer (generate-new-buffer mh-temp-fetch-buffer)) (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch") (expand-file-name (make-temp-name "~/mhe-fetch"))))) (with-current-buffer buffer diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 27c2d869f6b..fe895d7e23d 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1033,8 +1033,7 @@ necessary. If nil, the buffer name is generated." (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer) ;; Stream changed? (if (not (eq imap-default-stream stream)) - (with-current-buffer (get-buffer-create - (generate-new-buffer-name " *temp*")) + (with-current-buffer (generate-new-buffer " *temp*") (mapc 'make-local-variable imap-local-variables) (set-buffer-multibyte nil) (buffer-disable-undo) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index d0f8c1272d7..bc99f02fe33 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -386,8 +386,7 @@ Gnus might fail to display all of it.") (when (save-window-excursion (delete-other-windows) - (let ((buffer (get-buffer-create (generate-new-buffer-name - "*Warning*")))) + (let ((buffer (generate-new-buffer "*Warning*"))) (unwind-protect (with-current-buffer buffer (insert (substitute-command-keys diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 744c110f6b0..4975d4f35dd 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -431,16 +431,15 @@ instead of reading master file from disk." (defun flymake-proc--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)) + (with-current-buffer (generate-new-buffer + (concat "flymake:" (file-name-nondirectory file-name))) + (insert-file-contents file-name) + (current-buffer))) (defun flymake-proc--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)))) + (with-current-buffer (generate-new-buffer + (concat "flymake:" (buffer-name buffer))) (insert-buffer-substring buffer) (current-buffer))) diff --git a/lisp/simple.el b/lisp/simple.el index 9ed7a11de19..b1c949d7c6d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4307,8 +4307,7 @@ characters." (defun shell-command-to-string (command) "Execute shell command COMMAND and return its output as a string." (with-output-to-string - (with-current-buffer - standard-output + (with-current-buffer standard-output (shell-command command t)))) (defun process-file (program &optional infile buffer display &rest args) diff --git a/lisp/subr.el b/lisp/subr.el index 1b2d778454e..7461fa2a15c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3701,10 +3701,11 @@ also `with-temp-buffer'." (when (window-live-p (nth 1 state)) (select-window (nth 1 state) 'norecord))) -(defun generate-new-buffer (name) +(defun generate-new-buffer (name &optional inhibit-buffer-hooks) "Create and return a buffer with a name based on NAME. -Choose the buffer's name using `generate-new-buffer-name'." - (get-buffer-create (generate-new-buffer-name name))) +Choose the buffer's name using `generate-new-buffer-name'. +See `get-buffer-create' for the meaning of INHIBIT-BUFFER-HOOKS." + (get-buffer-create (generate-new-buffer-name name) inhibit-buffer-hooks)) (defmacro with-selected-window (window &rest body) "Execute the forms in BODY with WINDOW as the selected window. @@ -3866,12 +3867,14 @@ See the related form `with-temp-buffer-window'." (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. +The buffer does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. See also `with-temp-buffer'." (declare (indent 1) (debug t)) (let ((temp-file (make-symbol "temp-file")) (temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-file ,file) - (,temp-buffer (generate-new-buffer " *temp file*"))) + (,temp-buffer (generate-new-buffer " *temp file*" t))) (unwind-protect (prog1 (with-current-buffer ,temp-buffer @@ -3906,10 +3909,12 @@ Use a MESSAGE of \"\" to temporarily clear the echo area." (defmacro with-temp-buffer (&rest body) "Create a temporary buffer, and evaluate BODY there like `progn'. +The buffer does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. See also `with-temp-file' and `with-output-to-string'." (declare (indent 0) (debug t)) (let ((temp-buffer (make-symbol "temp-buffer"))) - `(let ((,temp-buffer (generate-new-buffer " *temp*"))) + `(let ((,temp-buffer (generate-new-buffer " *temp*" t))) ;; `kill-buffer' can change current-buffer in some odd cases. (with-current-buffer ,temp-buffer (unwind-protect @@ -3944,7 +3949,7 @@ of that nature." (defmacro with-output-to-string (&rest body) "Execute BODY, return the text it sent to `standard-output', as a string." (declare (indent 0) (debug t)) - `(let ((standard-output (generate-new-buffer " *string-output*"))) + `(let ((standard-output (generate-new-buffer " *string-output*" t))) (unwind-protect (progn (let ((standard-output standard-output)) diff --git a/src/buffer.c b/src/buffer.c index dfc34faf6e6..9e44345616e 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -37,7 +37,6 @@ along with GNU Emacs. If not, see . */ #include "window.h" #include "commands.h" #include "character.h" -#include "coding.h" #include "buffer.h" #include "region-cache.h" #include "indent.h" @@ -514,16 +513,33 @@ get_truename_buffer (register Lisp_Object filename) return Qnil; } -DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0, +/* Run buffer-list-update-hook if Vrun_hooks is non-nil, and BUF is NULL + or does not have buffer hooks inhibited. BUF is NULL when called by + make-indirect-buffer, since it does not inhibit buffer hooks. */ + +static void +run_buffer_list_update_hook (struct buffer *buf) +{ + if (! (NILP (Vrun_hooks) || (buf && buf->inhibit_buffer_hooks))) + call1 (Vrun_hooks, Qbuffer_list_update_hook); +} + +DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 2, 0, doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed. If BUFFER-OR-NAME is a string and a live buffer with that name exists, return that buffer. If no such buffer exists, create a new buffer with -that name and return it. If BUFFER-OR-NAME starts with a space, the new -buffer does not keep undo information. +that name and return it. + +If BUFFER-OR-NAME starts with a space, the new buffer does not keep undo +information. If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the +new buffer does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. This +avoids slowing down internal or temporary buffers that are never +presented to users or passed on to other applications. If BUFFER-OR-NAME is a buffer instead of a string, return it as given, even if it is dead. The return value is never nil. */) - (register Lisp_Object buffer_or_name) + (register Lisp_Object buffer_or_name, Lisp_Object inhibit_buffer_hooks) { register Lisp_Object buffer, name; register struct buffer *b; @@ -598,11 +614,7 @@ even if it is dead. The return value is never nil. */) set_string_intervals (name, NULL); bset_name (b, name); - b->inhibit_buffer_hooks - = (STRINGP (Vcode_conversion_workbuf_name) - && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name), - SBYTES (Vcode_conversion_workbuf_name)) == 0); - + b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks); bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt); reset_buffer (b); @@ -614,9 +626,8 @@ even if it is dead. The return value is never nil. */) /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer))); - /* And run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + + run_buffer_list_update_hook (b); return buffer; } @@ -890,9 +901,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) set_buffer_internal_1 (old_b); } - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks)) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (NULL); return buf; } @@ -1536,9 +1545,7 @@ This does not change the name of the visited file (if any). */) && !NILP (BVAR (current_buffer, auto_save_file_name))) call0 (intern ("rename-auto-save-file")); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !current_buffer->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (current_buffer); /* Refetch since that last call may have done GC. */ return BVAR (current_buffer, name); @@ -1612,7 +1619,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) buf = Fget_buffer (scratch); if (NILP (buf)) { - buf = Fget_buffer_create (scratch); + buf = Fget_buffer_create (scratch, Qnil); Fset_buffer_major_mode (buf); } return buf; @@ -1636,7 +1643,7 @@ other_buffer_safely (Lisp_Object buffer) buf = Fget_buffer (scratch); if (NILP (buf)) { - buf = Fget_buffer_create (scratch); + buf = Fget_buffer_create (scratch, Qnil); Fset_buffer_major_mode (buf); } @@ -1713,7 +1720,9 @@ buffer to be killed as the current buffer. If any of them returns nil, the buffer is not killed. The hook `kill-buffer-hook' is run before the buffer is actually killed. The buffer being killed will be current while the hook is running. Functions called by any of these hooks are -supposed to not change the current buffer. +supposed to not change the current buffer. Neither hook is run for +internal or temporary buffers created by `get-buffer-create' or +`generate-new-buffer' with argument INHIBIT-BUFFER-HOOKS non-nil. Any processes that have this buffer as the `process-buffer' are killed with SIGHUP. This function calls `replace-buffer-in-windows' for @@ -1973,9 +1982,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) bset_width_table (b, Qnil); unblock_input (); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (b); return Qt; } @@ -2015,9 +2022,7 @@ record_buffer (Lisp_Object buffer) fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list))); fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list)); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (XBUFFER (buffer)); } @@ -2054,9 +2059,7 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal, fset_buried_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list))); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (XBUFFER (buffer)); return Qnil; } @@ -5349,10 +5352,11 @@ init_buffer_once (void) Fput (Qkill_buffer_hook, Qpermanent_local, Qt); /* Super-magic invisible buffer. */ - Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1")); + Vprin1_to_string_buffer = + Fget_buffer_create (build_pure_c_string (" prin1"), Qt); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"))); + Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil)); inhibit_modification_hooks = 0; } @@ -5397,7 +5401,7 @@ init_buffer (void) #endif /* USE_MMAP_FOR_BUFFERS */ AUTO_STRING (scratch, "*scratch*"); - Fset_buffer (Fget_buffer_create (scratch)); + Fset_buffer (Fget_buffer_create (scratch, Qnil)); if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) Fset_buffer_multibyte (Qnil); @@ -6300,9 +6304,14 @@ Use Custom to set this variable and update the display. */); DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions, doc: /* List of functions called with no args to query before killing a buffer. The buffer being killed will be current while the functions are running. +See `kill-buffer'. If any of them returns nil, the buffer is not killed. Functions run by -this hook are supposed to not change the current buffer. */); +this hook are supposed to not change the current buffer. + +This hook is not run for internal or temporary buffers created by +`get-buffer-create' or `generate-new-buffer' with argument +INHIBIT-BUFFER-HOOKS non-nil. */); Vkill_buffer_query_functions = Qnil; DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook, @@ -6315,9 +6324,12 @@ The function `kill-all-local-variables' runs this before doing anything else. * doc: /* Hook run when the buffer list changes. Functions (implicitly) running this hook are `get-buffer-create', `make-indirect-buffer', `rename-buffer', `kill-buffer', `bury-buffer' -and `select-window'. Functions run by this hook should avoid calling -`select-window' with a nil NORECORD argument or `with-temp-buffer' -since either may lead to infinite recursion. */); +and `select-window'. This hook is not run for internal or temporary +buffers created by `get-buffer-create' or `generate-new-buffer' with +argument INHIBIT-BUFFER-HOOKS non-nil. + +Functions run by this hook should avoid calling `select-window' with a +nil NORECORD argument since it may lead to infinite recursion. */); Vbuffer_list_update_hook = Qnil; DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook"); diff --git a/src/buffer.h b/src/buffer.h index fe549c5dac1..b8c5162be4a 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -663,11 +663,11 @@ struct buffer /* Non-zero whenever the narrowing is changed in this buffer. */ bool_bf clip_changed : 1; - /* Non-zero for internally used temporary buffers that don't need to - run hooks kill-buffer-hook, buffer-list-update-hook, and - kill-buffer-query-functions. This is used in coding.c to avoid - slowing down en/decoding when there are a lot of these hooks - defined. */ + /* Non-zero for internal or temporary buffers that don't need to + run hooks kill-buffer-hook, kill-buffer-query-functions, and + buffer-list-update-hook. This is used in coding.c to avoid + slowing down en/decoding when a lot of these hooks are + defined, as well as by with-temp-buffer, for example. */ bool_bf inhibit_buffer_hooks : 1; /* List of overlays that end at or before the current center, diff --git a/src/callproc.c b/src/callproc.c index e3346e2eabb..4bca1e5ebd3 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -405,9 +405,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer))) { - Lisp_Object spec_buffer; - spec_buffer = buffer; - buffer = Fget_buffer_create (buffer); + Lisp_Object spec_buffer = buffer; + buffer = Fget_buffer_create (buffer, Qnil); /* Mention the buffer name for a better error message. */ if (NILP (buffer)) CHECK_BUFFER (spec_buffer); diff --git a/src/coding.c b/src/coding.c index 2142e7fa518..1afa4aa4749 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7821,7 +7821,7 @@ encode_coding (struct coding_system *coding) /* A string that serves as name of the reusable work buffer, and as base name of temporary work buffers used for code-conversion operations. */ -Lisp_Object Vcode_conversion_workbuf_name; +static Lisp_Object Vcode_conversion_workbuf_name; /* The reusable working buffer, created once and never killed. */ static Lisp_Object Vcode_conversion_reused_workbuf; @@ -7839,7 +7839,7 @@ code_conversion_restore (Lisp_Object arg) if (! NILP (workbuf)) { if (EQ (workbuf, Vcode_conversion_reused_workbuf)) - reused_workbuf_in_use = 0; + reused_workbuf_in_use = false; else Fkill_buffer (workbuf); } @@ -7857,13 +7857,13 @@ code_conversion_save (bool with_work_buf, bool multibyte) { Lisp_Object name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); - workbuf = Fget_buffer_create (name); + workbuf = Fget_buffer_create (name, Qt); } else { if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf))) Vcode_conversion_reused_workbuf - = Fget_buffer_create (Vcode_conversion_workbuf_name); + = Fget_buffer_create (Vcode_conversion_workbuf_name, Qt); workbuf = Vcode_conversion_reused_workbuf; } } @@ -7881,7 +7881,7 @@ code_conversion_save (bool with_work_buf, bool multibyte) bset_undo_list (current_buffer, Qt); bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil); if (EQ (workbuf, Vcode_conversion_reused_workbuf)) - reused_workbuf_in_use = 1; + reused_workbuf_in_use = true; set_buffer_internal (current); } @@ -11639,7 +11639,7 @@ syms_of_coding (void) staticpro (&Vcode_conversion_workbuf_name); Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*"); - reused_workbuf_in_use = 0; + reused_workbuf_in_use = false; PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use); DEFSYM (Qcharset, "charset"); diff --git a/src/coding.h b/src/coding.h index 4973cf89eb1..9ad1e954f8d 100644 --- a/src/coding.h +++ b/src/coding.h @@ -97,9 +97,6 @@ enum define_coding_undecided_arg_index extern Lisp_Object Vcoding_system_hash_table; -/* Name (or base name) of work buffer for code conversion. */ -extern Lisp_Object Vcode_conversion_workbuf_name; - /* Enumeration of index to an attribute vector of a coding system. */ enum coding_attr_index diff --git a/src/fileio.c b/src/fileio.c index c97f4daf20c..51f12e104ef 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4004,7 +4004,7 @@ by calling `format-decode', which see. */) record_unwind_current_buffer (); - workbuf = Fget_buffer_create (name); + workbuf = Fget_buffer_create (name, Qt); buf = XBUFFER (workbuf); delete_all_overlays (buf); diff --git a/src/minibuf.c b/src/minibuf.c index fc3fd92a880..1940564a80a 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -809,7 +809,7 @@ get_minibuffer (EMACS_INT depth) static char const name_fmt[] = " *Minibuf-%"pI"d*"; char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)]; AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, depth)); - buf = Fget_buffer_create (lname); + buf = Fget_buffer_create (lname, Qnil); /* Although the buffer's name starts with a space, undo should be enabled in it. */ diff --git a/src/print.c b/src/print.c index 008bf5e6391..ec271d914cc 100644 --- a/src/print.c +++ b/src/print.c @@ -562,7 +562,7 @@ temp_output_buffer_setup (const char *bufname) record_unwind_current_buffer (); - Fset_buffer (Fget_buffer_create (build_string (bufname))); + Fset_buffer (Fget_buffer_create (build_string (bufname), Qnil)); Fkill_all_local_variables (); delete_all_overlays (current_buffer); diff --git a/src/process.c b/src/process.c index 4fe8ac7fc0c..9efefb1de73 100644 --- a/src/process.c +++ b/src/process.c @@ -1731,7 +1731,7 @@ usage: (make-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); if (!NILP (buffer)) - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); /* Make sure that the child will be able to chdir to the current buffer's current directory, or its unhandled equivalent. We @@ -1768,7 +1768,7 @@ usage: (make-process &rest ARGS) */) QCname, concat2 (name, build_string (" stderr")), QCbuffer, - Fget_buffer_create (xstderr), + Fget_buffer_create (xstderr, Qnil), QCnoquery, query_on_exit ? Qnil : Qt); } @@ -2443,7 +2443,7 @@ usage: (make-pipe-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); if (NILP (buffer)) buffer = name; - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); pset_buffer (p, buffer); pset_childp (p, contact); @@ -3173,7 +3173,7 @@ usage: (make-serial-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); if (NILP (buffer)) buffer = name; - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); pset_buffer (p, buffer); pset_childp (p, contact); @@ -4188,7 +4188,7 @@ usage: (make-network-process &rest ARGS) */) open_socket: if (!NILP (buffer)) - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); /* Unwind bind_polling_period. */ unbind_to (count, Qnil); @@ -4961,7 +4961,7 @@ server_accept_connection (Lisp_Object server, int channel) if (!NILP (buffer)) { args[1] = buffer; - buffer = Fget_buffer_create (Fformat (nargs, args)); + buffer = Fget_buffer_create (Fformat (nargs, args), Qnil); } } diff --git a/src/w32fns.c b/src/w32fns.c index a840f0e1227..36bee0676ba 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -7372,7 +7372,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, tip_f = XFRAME (tip_frame); window = FRAME_ROOT_WINDOW (tip_f); - tip_buf = Fget_buffer_create (tip); + tip_buf = Fget_buffer_create (tip, Qnil); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); diff --git a/src/window.c b/src/window.c index bcc989b5a79..5db166e345e 100644 --- a/src/window.c +++ b/src/window.c @@ -617,11 +617,12 @@ equals the special symbol `mark-for-redisplay'. Run `buffer-list-update-hook' unless NORECORD is non-nil. Note that applications and internal routines often select a window temporarily for various purposes; mostly, to simplify coding. As a rule, such -selections should be not recorded and therefore will not pollute +selections should not be recorded and therefore will not pollute `buffer-list-update-hook'. Selections that "really count" are those causing a visible change in the next redisplay of WINDOW's frame and -should be always recorded. So if you think of running a function each -time a window gets selected put it on `buffer-list-update-hook'. +should always be recorded. So if you think of running a function each +time a window gets selected, put it on `buffer-list-update-hook' or +`window-selection-change-functions'. Also note that the main editor command loop sets the current buffer to the buffer of the selected window before each command. */) diff --git a/src/xdisp.c b/src/xdisp.c index 0fd5ec5ec56..b5adee51055 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10880,7 +10880,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) /* Ensure the Messages buffer exists, and switch to it. If we created it, set the major-mode. */ bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name)); - Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); + Fset_buffer (Fget_buffer_create (Vmessages_buffer_name, Qnil)); if (newbuffer && !NILP (Ffboundp (intern ("messages-buffer-mode")))) call0 (intern ("messages-buffer-mode")); @@ -11366,7 +11366,7 @@ ensure_echo_area_buffers (void) static char const name_fmt[] = " *Echo Area %d*"; char name[sizeof name_fmt + INT_STRLEN_BOUND (int)]; AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, i)); - echo_buffer[i] = Fget_buffer_create (lname); + echo_buffer[i] = Fget_buffer_create (lname, Qnil); bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil); /* to force word wrap in echo area - it was decided to postpone this*/ diff --git a/src/xfns.c b/src/xfns.c index 46e4bd73a6b..abe293e903e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7041,7 +7041,7 @@ Text larger than the specified size is clipped. */) tip_f = XFRAME (tip_frame); window = FRAME_ROOT_WINDOW (tip_f); - tip_buf = Fget_buffer_create (tip); + tip_buf = Fget_buffer_create (tip, Qnil); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); diff --git a/src/xwidget.c b/src/xwidget.c index e078a28a35b..accde65b523 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -100,7 +100,8 @@ Returns the newly constructed xwidget, or nil if construction fails. */) Lisp_Object val; xw->type = type; xw->title = title; - xw->buffer = NILP (buffer) ? Fcurrent_buffer () : Fget_buffer_create (buffer); + xw->buffer = (NILP (buffer) ? Fcurrent_buffer () + : Fget_buffer_create (buffer, Qnil)); xw->height = XFIXNAT (height); xw->width = XFIXNAT (width); xw->kill_without_query = false; diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 0db66f97517..dd8927457ae 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -19,9 +19,7 @@ ;;; Code: -(require 'ert) -(require 'seq) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (ert-deftest overlay-modification-hooks-message-other-buf () "Test for bug#21824. @@ -1334,4 +1332,33 @@ with parameters from the *Messages* buffer modification." (with-temp-buffer (should (assq 'buffer-undo-list (buffer-local-variables))))) +(ert-deftest buffer-tests-inhibit-buffer-hooks () + "Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS." + (let* (run-bluh (bluh (lambda () (setq run-bluh t)))) + (unwind-protect + (let* ( run-kbh (kbh (lambda () (setq run-kbh t))) + run-kbqf (kbqf (lambda () (setq run-kbqf t))) ) + + ;; Inhibited. + (add-hook 'buffer-list-update-hook bluh) + (with-current-buffer (generate-new-buffer " foo" t) + (add-hook 'kill-buffer-hook kbh nil t) + (add-hook 'kill-buffer-query-functions kbqf nil t) + (kill-buffer)) + (with-temp-buffer) + (with-output-to-string) + (should-not run-bluh) + (should-not run-kbh) + (should-not run-kbqf) + + ;; Not inhibited. + (with-current-buffer (generate-new-buffer " foo") + (should run-bluh) + (add-hook 'kill-buffer-hook kbh nil t) + (add-hook 'kill-buffer-query-functions kbqf nil t) + (kill-buffer)) + (should run-kbh) + (should run-kbqf)) + (remove-hook 'buffer-list-update-hook bluh)))) + ;;; buffer-tests.el ends here From ecb5ebf156280be1859f181208306e4c55af3e80 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 20 Dec 2020 19:45:11 +0100 Subject: [PATCH 147/148] Improve make-process in Tramp * doc/misc/tramp.texi (Remote processes): Remove INSIDE_EMACS restriction. (Frequently Asked Questions, External packages): Add indices. * etc/NEWS: 'start-process-shell-command' and 'start-file-process-shell-command' do not support the old calling conventions any longer. * lisp/subr.el (start-process-shell-command) (start-file-process-shell-command): Remove old calling conventions. * lisp/net/tramp-compat.el (remote-file-error): Remove, it isn't necessary. * lisp/net/tramp.el (tramp-handle-make-process): Remove special shell handling. Support environment variables. * test/lisp/net/tramp-tests.el (tramp--test--deftest-direct-async-process): Skip for mock method. (tramp--test-async-shell-command): Suppress `shell-command-sentinel'. (tramp-test32-shell-command, tramp-test33-environment-variables): Adapt tests. (tramp-test32-shell-command-direct-async) (tramp-test33-environment-variables-direct-async): New tests. --- doc/misc/tramp.texi | 7 ++- etc/NEWS | 8 ++- lisp/net/tramp-compat.el | 5 -- lisp/net/tramp.el | 32 +++++++---- lisp/subr.el | 19 ++---- test/lisp/net/tramp-tests.el | 108 +++++++++++++++++++++-------------- 6 files changed, 100 insertions(+), 79 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 0557ca54695..dd350f10c0b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3584,9 +3584,6 @@ It does not set process property @code{remote-pid}. @item It does not use @code{tramp-remote-path} and @code{tramp-remote-process-environment}. - -@item -It does not set environment variable @env{INSIDE_EMACS}. @end itemize In order to gain even more performance, it is recommended to bind @@ -4880,6 +4877,8 @@ In case you have installed it from its Git repository, @ref{Recompilation}. @item I get an error @samp{Remote file error: Forbidden reentrant call of Tramp} +@vindex remote-file-error +@vindex debug-ignored-errors Timers, process filters and sentinels, and other event based functions can run at any time, when a remote file operation is still running. This can cause @value{tramp} to block. When such a situation is @@ -5021,6 +5020,7 @@ bind it to non-@code{nil} value. @subsection File attributes cache +@vindex process-file-side-effects Keeping a local cache of remote file attributes in sync with the remote host is a time-consuming operation. Flushing and re-querying these attributes can tax @value{tramp} to a grinding halt on busy @@ -5061,6 +5061,7 @@ root-directory, it is most likely sufficient to make the @subsection Timers +@vindex remote-file-error Timers run asynchronously at any time when Emacs is waiting for sending a string to a process, or waiting for process output. They can run any remote file operation, which would conflict with the diff --git a/etc/NEWS b/etc/NEWS index 1b4c21cb450..7411295e1b5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1482,7 +1482,7 @@ This new option allows the user to customize how case is converted when unifying entries. --- -*** The user option `bibtex-maintain-sorted-entries' now permits +*** The user option 'bibtex-maintain-sorted-entries' now permits user-defined sorting schemes. +++ @@ -2170,6 +2170,7 @@ and 'play-sound-file'. If this variable is non-nil, character syntax is used for printing numbers when this makes sense, such as '?A' for 65. ++++ ** New error 'remote-file-error', a subcategory of 'file-error'. It is signaled if a remote file operation fails due to internal reasons, and could block Emacs. It does not replace 'file-error' @@ -2182,6 +2183,7 @@ Until it is solved you could ignore such errors by performing (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) ++++ ** The error 'ftp-error' belongs also to category 'remote-file-error'. +++ @@ -2193,6 +2195,10 @@ buffer does not run the hooks 'kill-buffer-hook', avoids slowing down internal or temporary buffers that are never presented to users or passed on to other applications. +--- +** 'start-process-shell-command' and 'start-file-process-shell-command' +do not support the old calling conventions any longer. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 4c8d37d602c..b44eabcfa8b 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -348,11 +348,6 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) -;; Error symbol `remote-file-error' is defined in Emacs 28.1. We use -;; an adapted error message in order to see that compatible symbol. -(unless (get 'remote-file-error 'error-conditions) - (define-error 'remote-file-error "Remote file error (compat)" 'file-error)) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6c1c09bc371..4d8118a728b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3790,23 +3790,31 @@ It does not support `:stderr'." (unless (or (null stderr) (bufferp stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) - ;; Quote shell command. - (when (and (= (length command) 3) - (stringp (nth 0 command)) - (string-match-p "sh$" (nth 0 command)) - (stringp (nth 1 command)) - (string-equal "-c" (nth 1 command)) - (stringp (nth 2 command))) - (setcar (cddr command) (tramp-shell-quote-argument (nth 2 command)))) - (let* ((buffer (if buffer (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + (env (mapcar + (lambda (elt) + (unless + (member + elt (default-toplevel-value 'process-environment)) + (when (string-match-p "=" elt) elt))) + process-environment)) + (env (setenv-internal + env "INSIDE_EMACS" + (concat (or (getenv "INSIDE_EMACS") emacs-version) + ",tramp:" tramp-version) + 'keep)) + (env (mapcar #'tramp-shell-quote-argument (delq nil env))) + ;; Quote command. + (command (mapconcat #'tramp-shell-quote-argument command " ")) + ;; Set cwd and environment variables. (command - (mapconcat - #'identity (append `("cd" ,localname "&&") command) " "))) + (append `("cd" ,localname "&&" "(" "env") env `(,command ")")))) ;; Check for `tramp-sh-file-name-handler', because something ;; is different between tramp-adb.el and tramp-sh.el. @@ -3861,7 +3869,7 @@ It does not support `:stderr'." (mapcar (lambda (x) (split-string x " ")) login-args)) p (make-process :name name :buffer buffer - :command (append `(,login-program) login-args `(,command)) + :command (append `(,login-program) login-args command) :coding coding :noquery noquery :connection-type connection-type :filter filter :sentinel sentinel :stderr stderr)) diff --git a/lisp/subr.el b/lisp/subr.el index 7461fa2a15c..cb64b3f6e74 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3560,7 +3560,7 @@ Do nothing if FACE is nil." ;;;; Synchronous shell commands. -(defun start-process-shell-command (name buffer &rest args) +(defun start-process-shell-command (name buffer command) "Start a program in a subprocess. Return the process object for it. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer name) to associate with the process. @@ -3568,27 +3568,18 @@ BUFFER is the buffer (or buffer name) to associate with the process. an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer -COMMAND is the shell command to run. - -An old calling convention accepted any number of arguments after COMMAND, -which were just concatenated to COMMAND. This is still supported but strongly -discouraged." - (declare (advertised-calling-convention (name buffer command) "23.1")) +COMMAND is the shell command to run." ;; We used to use `exec' to replace the shell with the command, ;; but that failed to handle (...) and semicolon, etc. - (start-process name buffer shell-file-name shell-command-switch - (mapconcat 'identity args " "))) + (start-process name buffer shell-file-name shell-command-switch command)) -(defun start-file-process-shell-command (name buffer &rest args) +(defun start-file-process-shell-command (name buffer command) "Start a program in a subprocess. Return the process object for it. Similar to `start-process-shell-command', but calls `start-file-process'." - (declare (advertised-calling-convention (name buffer command) "23.1")) ;; On remote hosts, the local `shell-file-name' might be useless. (with-connection-local-variables (start-file-process - name buffer - shell-file-name shell-command-switch - (mapconcat 'identity args " ")))) + name buffer shell-file-name shell-command-switch command))) (defun call-process-shell-command (command &optional infile buffer display &rest args) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0a5931d6893..9dd98037a0e 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4459,6 +4459,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (start-file-process "test4" (current-buffer) nil) :type 'wrong-type-argument) + (setq proc (start-file-process "test4" (current-buffer) nil)) (should (processp proc)) (should (equal (process-status proc) 'run)) @@ -4483,6 +4484,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (tramp-connection-properties (cons '(nil "direct-async-process" t) tramp-connection-properties))) (skip-unless (tramp-direct-async-process-p)) + ;; For whatever reason, it doesn't cooperate with the "mock" method. + (skip-unless (not (tramp--test-mock-p))) ;; We do expect an established connection already, ;; `file-truename' does it by side-effect. Suppress ;; `tramp--test-enabled', in order to keep the connection. @@ -4703,12 +4706,14 @@ INPUT, if non-nil, is a string sent to the process." (async-shell-command command output-buffer error-buffer) (let ((proc (get-buffer-process output-buffer)) (delete-exited-processes t)) - (when (stringp input) - (process-send-string proc input)) - (with-timeout - ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) - (while (or (accept-process-output proc nil nil t) (process-live-p proc)))) - (accept-process-output proc nil nil t))) + (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore)) + (when (stringp input) + (process-send-string proc input)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while + (or (accept-process-output proc nil nil t) (process-live-p proc)))) + (accept-process-output proc nil nil t)))) (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." @@ -4762,19 +4767,20 @@ INPUT, if non-nil, is a string sent to the process." (ignore-errors (delete-file tmp-name))) ;; Test `{async-}shell-command' with error buffer. - (let ((stderr (generate-new-buffer "*stderr*"))) - (unwind-protect - (with-temp-buffer - (funcall - this-shell-command - "echo foo >&2; echo bar" (current-buffer) stderr) - (should (string-equal "bar\n" (buffer-string))) - ;; Check stderr. - (with-current-buffer stderr - (should (string-equal "foo\n" (buffer-string))))) + (unless (tramp-direct-async-process-p) + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (funcall + this-shell-command + "echo foo >&2; echo bar" (current-buffer) stderr) + (should (string-equal "bar\n" (buffer-string))) + ;; Check stderr. + (with-current-buffer stderr + (should (string-equal "foo\n" (buffer-string))))) - ;; Cleanup. - (ignore-errors (kill-buffer stderr))))) + ;; Cleanup. + (ignore-errors (kill-buffer stderr)))))) ;; Test sending string to `async-shell-command'. (unwind-protect @@ -4810,6 +4816,9 @@ INPUT, if non-nil, is a string sent to the process." (when (natnump cols) (should (= cols async-shell-command-width)))))) +(tramp--test--deftest-direct-async-process tramp-test32-shell-command + "Check direct async `shell-command'.") + ;; This test is inspired by Bug#39067. (ert-deftest tramp-test32-shell-command-dont-erase-buffer () "Check `shell-command-dont-erase-buffer'." @@ -4961,7 +4970,7 @@ INPUT, if non-nil, is a string sent to the process." (should (string-equal (format "%s,tramp:%s\n" emacs-version tramp-version) - (funcall this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}"))) + (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))) (let ((process-environment (cons (format "INSIDE_EMACS=%s,foo" emacs-version) process-environment))) @@ -4969,7 +4978,7 @@ INPUT, if non-nil, is a string sent to the process." (string-equal (format "%s,foo,tramp:%s\n" emacs-version tramp-version) (funcall - this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}")))) + this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))) ;; Set a value. (let ((process-environment @@ -4979,7 +4988,8 @@ INPUT, if non-nil, is a string sent to the process." (string-match "foo" (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))) + this-shell-command-to-string + (format "echo \"${%s:-bla}\"" envvar))))) ;; Set the empty value. (let ((process-environment @@ -4989,38 +4999,45 @@ INPUT, if non-nil, is a string sent to the process." (string-match "bla" (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) + this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar)))) ;; Variable is set. (should (string-match (regexp-quote envvar) (funcall this-shell-command-to-string "set")))) - ;; We force a reconnect, in order to have a clean environment. - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - ;; Unset the variable. - (let ((tramp-remote-process-environment - (cons (concat envvar "=foo") tramp-remote-process-environment))) - ;; Set the initial value, we want to unset below. - (should - (string-match - "foo" - (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) - (let ((process-environment (cons envvar process-environment))) - ;; Variable is unset. + (unless (tramp-direct-async-process-p) + ;; We force a reconnect, in order to have a clean environment. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + ;; Unset the variable. + (let ((tramp-remote-process-environment + (cons (concat envvar "=foo") tramp-remote-process-environment))) + ;; Set the initial value, we want to unset below. (should (string-match - "bla" + "foo" (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) - ;; Variable is unset. - (should-not - (string-match - (regexp-quote envvar) - ;; We must remove PS1, the output is truncated otherwise. - (funcall - this-shell-command-to-string "printenv | grep -v PS1")))))))) + this-shell-command-to-string + (format "echo \"${%s:-bla}\"" envvar)))) + (let ((process-environment (cons envvar process-environment))) + ;; Variable is unset. + (should + (string-match + "bla" + (funcall + this-shell-command-to-string + (format "echo \"${%s:-bla}\"" envvar)))) + ;; Variable is unset. + (should-not + (string-match + (regexp-quote envvar) + ;; We must remove PS1, the output is truncated otherwise. + (funcall + this-shell-command-to-string "printenv | grep -v PS1"))))))))) + +(tramp--test--deftest-direct-async-process tramp-test33-environment-variables + "Check that remote processes set / unset environment variables properly. +Use direct async.") ;; This test is inspired by Bug#27009. (ert-deftest tramp-test33-environment-variables-and-port-numbers () @@ -6432,6 +6449,9 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive)))))) +;; (tramp--test--deftest-direct-async-process tramp-test43-asynchronous-requests +;; "Check parallel direct asynchronous requests.") + ;; This test is inspired by Bug#29163. (ert-deftest tramp-test44-auto-load () "Check that Tramp autoloads properly." From 1a7033f1f3de4ad8c1bfd68b54e6c9d8444a3bcc Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 20 Dec 2020 22:05:51 +0200 Subject: [PATCH 148/148] * lisp/simple.el (goto-line-read-args): Use number-at-point (bug#45199) * lisp/subr.el (goto-char--read-natnum-interactive): Add the value of point to the end of default values, and move function slightly higher. --- lisp/simple.el | 12 ++---------- lisp/subr.el | 18 +++++++++--------- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index b1c949d7c6d..2b13a0d4867 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1264,7 +1264,6 @@ that uses or sets the mark." ;; minibuffer, this is at the end of the prompt. (goto-char (minibuffer-prompt-end))) - ;; Counting lines, one way or another. (defvar goto-line-history nil @@ -1276,15 +1275,8 @@ that uses or sets the mark." (if (and current-prefix-arg (not (consp current-prefix-arg))) (list (prefix-numeric-value current-prefix-arg)) ;; Look for a default, a number in the buffer at point. - (let* ((default - (save-excursion - (skip-chars-backward "0-9") - (if (looking-at "[0-9]") - (string-to-number - (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "0-9") - (point))))))) + (let* ((number (number-at-point)) + (default (and (natnump number) number)) ;; Decide if we're switching buffers. (buffer (if (consp current-prefix-arg) diff --git a/lisp/subr.el b/lisp/subr.el index cb64b3f6e74..9527f7120aa 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2719,6 +2719,15 @@ floating point support." (push (cons t read) unread-command-events) nil)))))) +(defun goto-char--read-natnum-interactive (prompt) + "Get a natural number argument, optionally prompting with PROMPT. +If there is a natural number at point, use it as default." + (if (and current-prefix-arg (not (consp current-prefix-arg))) + (list (prefix-numeric-value current-prefix-arg)) + (let* ((number (number-at-point)) + (default (and (natnump number) number))) + (list (read-number prompt (list default (point))))))) + (defvar read-char-history nil "The default history for the `read-char-from-minibuffer' function.") @@ -2820,15 +2829,6 @@ There is no need to explicitly add `help-char' to CHARS; (message "%s%s" prompt (char-to-string char)) char)) -(defun goto-char--read-natnum-interactive (prompt) - "Get a natural number argument, optionally prompting with PROMPT. -If there is a natural number at point, use it as default." - (if (and current-prefix-arg (not (consp current-prefix-arg))) - (list (prefix-numeric-value current-prefix-arg)) - (let* ((number (number-at-point)) - (default (and (natnump number) number))) - (list (read-number prompt default))))) - ;; Behind display-popup-menus-p test. (declare-function x-popup-dialog "menu.c" (position contents &optional header))