daniel/emacs-conf
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2026-06-27 11:34:21 +02:00
parent 4be4f859c4
commit 1aaef48596
246 changed files with 7997 additions and 4359 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/company/company-capf.el
+2 -1
View File
@@ -36,7 +36,8 @@
:group 'company)
(defcustom company-capf-disabled-functions '(tags-completion-at-point-function
ispell-completion-at-point)
ispell-completion-at-point
company--fake-capf-complete-common)
"List of completion functions which should be ignored in this backend.
By default it contains the functions that duplicate the built-in backends
lisp/company/company-childframe.el
+253
View File
@@ -0,0 +1,253 @@
;;; company-childframe.el --- Graphical popup frontend for Company -*- lexical-binding: t -*-
;; Copyright (C) 2026 Free Software Foundation, Inc.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Tooltip completion menu frontend for Company that uses a child frame.
;;
;; A lot of the code here was imported from the package `company-posframe',
;; credit to Clément Pit-Claudel, Feng Shu and others.
;;; Code:
(require 'company)
(require 'posframe)
(defgroup company-childframe nil
"Group group group"
:group 'company)
(defcustom company-childframe-font nil
"The font used by company-childframe's frame.
Using current frame's font if it is nil."
:type 'face)
(defcustom company-childframe-border-width 1
"The width of the popup's border, in graphical frames.
Users of HiDPI screens might like to set it to 2."
:type 'integer)
(defvar company-childframe-buffer " *company-childframe-buffer*"
"company-childframe's buffer which used by posframe.")
(defvar company-childframe--frame nil)
(defvar company-childframe-show-params nil
"List of extra parameters passed to `posframe-show' in
`company-childframe-show'.")
(defvar company-childframe-last-status nil)
(defvar company-childframe-buffer-map
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap company-active-map)
(define-key keymap [wheel-down] 'company-childframe-wheel-up)
(define-key keymap [wheel-up] 'company-childframe-wheel-down)
keymap)
"Keymap for the child frame's popup/buffer.")
(defun company-childframe-wheel-up ()
"Scroll up the displayed candidates."
(interactive)
(company-childframe--wheel-scroll 3))
(defun company-childframe-wheel-down ()
"Scroll up the displayed candidates."
(interactive)
(company-childframe--wheel-scroll -3))
(defun company-childframe--wheel-scroll (amount)
(let ((parent-frame (frame-parameter nil 'parent-frame))
(parent-buffer (frame-parameter nil 'posframe-parent-buffer)))
(when (and parent-frame
parent-buffer)
(select-frame parent-frame)
(select-window (get-buffer-window (cdr parent-buffer)))
(company-select-next amount))))
(defvar company-childframe-poshandler
#'company-childframe-show-at-prefix
"Poshandler for the completion dialog.")
(defun company-childframe-show-at-prefix (info)
"Poshandler showing `company-childframe' at `company-prefix'."
(let* ((parent-window (plist-get info :parent-window))
(point (- (plist-get info :position)
(plist-get info :company-prefix-length)))
(after-string-width
(with-current-buffer (window-buffer parent-window)
(thread-last
(and (= point (point-max))
(overlays-in point point))
(mapcar (lambda (o) (company--string-pixel-width
(overlay-get o 'after-string))))
(cl-reduce #'+))))
(posn (posn-at-point point parent-window))
;; TODO: Strictly speaking, if company-childframe-font is not nil, that
;; should be used to find the default width...
(expected-margin-width (* (plist-get info :company-margin) (default-font-width)))
(xy (posn-x-y posn)))
(setcar xy (- (car xy) expected-margin-width
(if (display-graphic-p)
company-childframe-border-width
0)
;; Might bite us if the posn-at-point behavior changes
;; someday, but the odds seem low.
after-string-width))
(posframe-poshandler-point-bottom-left-corner (plist-put info :position posn))))
(defun company-childframe-show ()
"Show company-childframe candidate menu."
(defvar x-wait-for-event-timeout)
(defvar x-fast-protocol-requests)
(let* ((x-wait-for-event-timeout (and (>= emacs-major-version 31)
;; debbugs#80662
(bound-and-true-p
x-wait-for-event-timeout)))
(before-make-frame-hook)
(after-make-frame-functions)
(x-fast-protocol-requests t)
(height (min company-tooltip-limit
(if company-search-mode
(1+ company-candidates-length)
company-candidates-length)))
(company-lines (company--create-lines company-selection height))
(margin (car company-lines))
(lines (cdr company-lines))
(width (length (car lines)))
(contents (mapconcat #'identity lines "\n"))
(buffer (get-buffer-create company-childframe-buffer)))
(when (and (eq (frame-live-p company-childframe--frame) 'x)
(not (eq (car (frame-list)) company-childframe--frame)))
;; Make sure it's the first in the list, to avoid premature sync when some
;; other frame is redisplayed first. Again, non-atomic updated on X11.
;; https://debbugs.gnu.org/80662#185
(delete-frame company-childframe--frame))
(apply #'posframe-show buffer
:string contents
:height height
:width (if (or (<= company-candidates-length
height)
(not (display-graphic-p)))
width
(1- width))
:font company-childframe-font
:background-color (face-attribute 'company-tooltip :background)
:lines-truncate t
:override-parameters '((inhibit-double-buffering . t))
:border-width (and (display-graphic-p) company-childframe-border-width)
;; :border-color "light salmon"
;; :border-color "light steel blue"
;; We'll probably want a separate face for it.
:border-color (face-attribute 'company-tooltip-scrollbar-track :background)
:poshandler company-childframe-poshandler
:poshandler-extra-info
(list :company-margin margin
:company-prefix-length (length (car (company--boundaries))))
company-childframe-show-params)
(with-current-buffer buffer
(use-local-map company-childframe-buffer-map)
(setq company-childframe--frame posframe--frame)
;; FIXME: Does not honor remappings by minor modes in the parent buffer,
;; e.g. the special behavior of C-d with parent-mode, etc.
(add-hook 'pre-command-hook
#'company-childframe--pre-command
nil t))))
(defun company-childframe-hide ()
"Hide company-childframe candidate menu."
(when (and (frame-live-p company-childframe--frame)
(frame-visible-p company-childframe--frame))
;; PGTK/NS/W32 protocols can update the display atomically.
(when (and (eq window-system 'x)
;; https://debbugs.gnu.org/80961
(< 32 emacs-major-version))
;; Seems to help avoid the final flicker - probably by keeping the parent's
;; display matrix up to date (so it can repaint on Expose immediately).
(redisplay))
(make-frame-invisible company-childframe--frame)))
;;;###autoload
(defun company-childframe-frontend (command)
"`company-mode' frontend using childframe.
For COMMAND refer to `company-frontends'."
(setq company-childframe-last-status
(list (selected-window)
(current-buffer)))
(cl-case command
(pre-command
(when (not (posframe-workable-p))
(user-error "Child frames not supported")))
(show (setq company--tooltip-current-width 0))
(hide
(company-childframe-hide))
(post-command
(when (equal (window-buffer (selected-window))
(current-buffer))
(company-childframe-show)))
(select-mouse
(company-childframe--select-mouse))))
(defun company-childframe--select-mouse ()
(let ((event-col-row (company--event-col-row company-mouse-event))
(event-window (posn-window (event-start company-mouse-event))))
(cond ((and event-window
(equal (buffer-name (window-buffer event-window))
company-childframe-buffer))
(company-set-selection (+ (cdr event-col-row)
company-tooltip-offset
(if (and (eq company-tooltip-offset-display 'lines)
(not (zerop company-tooltip-offset)))
-1 0)))
t))))
(defun company-childframe--pre-command ()
(let ((parent-frame (frame-parameter nil 'parent-frame))
(parent-buffer (cdr (frame-parameter nil 'posframe-parent-buffer))))
(when (and
(not (memq this-command
'(company-childframe-wheel-up
company-childframe-wheel-down)))
parent-frame parent-buffer)
(select-frame parent-frame)
(select-window (get-buffer-window parent-buffer)))))
;;;###autoload
(defun company-childframe-unless-just-one-frontend (command)
"`company-childframe-frontend', but not shown for single candidates."
(if (company--show-inline-p)
(and (member command '(post-command hide))
(company-childframe-hide))
(and (memq command '(post-command show unhide hide select-mouse))
(company-childframe-frontend command))))
(defun company-childframe-window-change ()
"Hide posframe on window change."
(when (posframe-workable-p)
(unless (or (equal (buffer-name) company-childframe-buffer)
(equal company-childframe-last-status
(list (selected-window)
(current-buffer))))
(company-childframe-hide))))
(add-hook 'window-configuration-change-hook
#'company-childframe-window-change)
(provide 'company-childframe)
;;; company-childframe.el ends here
lisp/company/company-pkg.el
+5 -4
View File
@@ -1,9 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company" "20260331.245"
(define-package "company" "20260627.324"
"Modular text completion framework."
'((emacs "26.1"))
'((emacs "26.1")
(posframe "1.5.1"))
:url "http://company-mode.github.io/"
:commit "59626254bbac187fc2b8d7a189aca90976ab36a8"
:revdesc "59626254bbac"
:commit "a703d9f9ce57d37d6b0c073b54348e8b620cebc1"
:revdesc "a703d9f9ce57"
:keywords '("abbrev" "convenience" "matching")
:maintainers '(("Dmitry Gutov" . "dmitry@gutov.dev")))
lisp/company/company.el
+254 -74
View File
@@ -1,14 +1,14 @@
;;; company.el --- Modular text completion framework -*- lexical-binding: t -*-
;; Copyright (C) 2009-2025 Free Software Foundation, Inc.
;; Copyright (C) 2009-2026 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dmitry@gutov.dev>
;; URL: http://company-mode.github.io/
;; Package-Version: 20260331.245
;; Package-Revision: 59626254bbac
;; Package-Version: 20260627.324
;; Package-Revision: a703d9f9ce57
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "26.1"))
;; Package-Requires: ((emacs "26.1") (posframe "1.5.1"))
;; This file is part of GNU Emacs.
@@ -99,11 +99,11 @@
"Face used for the deprecated items.")
(defface company-tooltip-search
'((default :inherit highlight))
'((default :inherit isearch))
"Face used for the search string in the tooltip.")
(defface company-tooltip-search-selection
'((default :inherit highlight))
'((default :inherit isearch))
"Face used for the search string inside the selection in the tooltip.")
(defface company-tooltip-mouse
@@ -175,7 +175,7 @@
"Face used for the common part of the completion preview.")
(defface company-preview-search
'((default :inherit company-tooltip-common-selection))
'((default :inherit isearch))
"Face used for the search string in the completion preview.")
(defface company-echo nil
@@ -192,21 +192,22 @@
(defun company-frontends-set (variable value)
;; Uniquify.
(let ((value (delete-dups (copy-sequence value))))
(and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
(memq 'company-pseudo-tooltip-frontend value))
(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
(memq 'company-pseudo-tooltip-frontend value))
(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
(memq 'company-pseudo-tooltip-unless-just-one-frontend value)))
(user-error "Pseudo tooltip frontend cannot be used more than once"))
(and (or (and (memq 'company-preview-if-just-one-frontend value)
(memq 'company-preview-frontend value))
(and (memq 'company-preview-if-just-one-frontend value)
(memq 'company-preview-common-frontend value))
(and (memq 'company-preview-frontend value)
(memq 'company-preview-common-frontend value))
)
(let ((value (delete-dups (copy-sequence value)))
(tooltip-frontends
'(company-pseudo-tooltip-frontend
company-pseudo-tooltip-unless-just-one-frontend
company-pseudo-tooltip-unless-just-one-frontend-with-delay
company-childframe-frontend
company-childframe-unless-just-one-frontend))
(preview-frontends
'(company-preview-if-just-one-frontend
company-preview-common-frontend
company-preview-frontend)))
(and (> (cl-count-if (lambda (el) (member el tooltip-frontends)) value)
1)
(user-error "Any tooltip frontend can be used only once"))
(and (> (cl-count-if (lambda (el) (member el preview-frontends)) value)
1)
(user-error "Preview frontend cannot be used twice"))
(and (memq 'company-echo value)
(memq 'company-echo-metadata-frontend value)
@@ -217,7 +218,11 @@
(setq value (append (delq f value) (list f)))))
(set variable value)))
(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
(defcustom company-frontends `(,@(list
(if (or (memq window-system '(ns mac w32 pgtk))
(< 30 emacs-major-version))
'company-childframe-unless-just-one-frontend
'company-pseudo-tooltip-unless-just-one-frontend))
company-preview-if-just-one-frontend
company-echo-metadata-frontend)
"The list of active frontends (visualizations).
@@ -243,20 +248,25 @@ for technical reasons.
The visualized data is stored in `company-prefix', `company-candidates',
`company-common', `company-selection', `company-point' and
`company-search-string'."
:package-version '(company . "1.1.0")
:set 'company-frontends-set
:type '(repeat (choice (const :tag "echo" company-echo-frontend)
(const :tag "echo, strip common"
company-echo-strip-common-frontend)
(const :tag "show echo meta-data in echo"
(const :tag "show completion's meta-data in echo"
company-echo-metadata-frontend)
(const :tag "pseudo tooltip"
(const :tag "graphical tooltip"
company-childframe-frontend)
(const :tag "graphical tooltip, multiple completions only"
company-childframe-unless-just-one-frontend)
(const :tag "overlays based tooltip"
company-pseudo-tooltip-frontend)
(const :tag "pseudo tooltip, multiple only"
(const :tag "overlays based tooltip, multiple completions only"
company-pseudo-tooltip-unless-just-one-frontend)
(const :tag "pseudo tooltip, multiple only, delayed"
(const :tag "overlays based tooltip, multiple completions only, delayed"
company-pseudo-tooltip-unless-just-one-frontend-with-delay)
(const :tag "preview" company-preview-frontend)
(const :tag "preview, unique only"
(const :tag "preview, unique completion only"
company-preview-if-just-one-frontend)
(const :tag "preview, common"
company-preview-common-frontend)
@@ -272,22 +282,22 @@ When that many lines are not available between point and the bottom of the
window, display the tooltip above point."
:type 'integer)
(defcustom company-tooltip-minimum-width 0
(defcustom company-tooltip-minimum-width 15
"The minimum width of the tooltip's inner area.
This doesn't include the margins and the scroll bar."
:type 'integer
:package-version '(company . "0.8.0"))
:package-version '(company . "1.1.0"))
(defcustom company-tooltip-maximum-width most-positive-fixnum
(defcustom company-tooltip-maximum-width 100
"The maximum width of the tooltip's inner area.
This doesn't include the margins and the scroll bar."
:type 'integer
:package-version '(company . "0.9.5"))
:package-version '(company . "1.1.0"))
(defcustom company-tooltip-width-grow-only nil
(defcustom company-tooltip-width-grow-only 50
"When non-nil, the tooltip width is not allowed to decrease."
:type 'boolean
:package-version '(company . "0.10.0"))
:package-version '(company . "1.1.0"))
(defcustom company-tooltip-margin 1
"Width of margin columns to show around the toolip."
@@ -882,15 +892,17 @@ asynchronous call into synchronous.")
;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-mode-map (make-sparse-keymap)
(defvar company-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap [remap indent-for-tab-command] 'company-indent-for-tab-command)
(define-key keymap [remap c-indent-line-or-region] 'company-indent-for-tab-command)
keymap)
"Keymap used by `company-mode'.")
(defvar company-active-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "\e\e\e" 'company-abort)
(define-key keymap "\C-g" 'company-abort)
(define-key keymap (kbd "M-n") 'company--select-next-and-warn)
(define-key keymap (kbd "M-p") 'company--select-previous-and-warn)
(define-key keymap (kbd "C-n") 'company-select-next-or-abort)
(define-key keymap (kbd "C-p") 'company-select-previous-or-abort)
(define-key keymap (kbd "<down>") 'company-select-next-or-abort)
@@ -908,9 +920,12 @@ asynchronous call into synchronous.")
(define-key keymap [tab] 'company-complete-common-or-cycle)
(define-key keymap (kbd "TAB") 'company-complete-common-or-cycle)
(define-key keymap [backtab] 'company-cycle-backward)
(define-key keymap (kbd "<f1>") 'company-show-doc-buffer)
(define-key keymap (kbd "C-h") 'company-show-doc-buffer)
(define-key keymap "\C-w" 'company-show-location)
(define-key keymap (kbd "C-M-i") 'company-complete-common)
(define-key keymap (kbd "<f1>") 'company--show-doc-buffer-and-warn)
(define-key keymap (kbd "C-h") 'company--show-doc-buffer-and-warn)
(define-key keymap (kbd "M-h") 'company-show-doc-buffer)
(define-key keymap (kbd "C-w") 'company--show-location-and-warn)
(define-key keymap (kbd "M-g") 'company-show-location)
(define-key keymap "\C-s" 'company-search-candidates)
(define-key keymap "\C-\M-s" 'company-filter-candidates)
(company-keymap--bind-quick-access keymap)
@@ -919,22 +934,12 @@ asynchronous call into synchronous.")
(defvar company--disabled-backends nil)
(defun company--select-next-and-warn (&optional arg)
(interactive "p")
(company--warn-changed-binding)
(company-select-next arg))
(defun company--select-previous-and-warn (&optional arg)
(interactive "p")
(company--warn-changed-binding)
(company-select-previous arg))
(defun company--warn-changed-binding ()
(interactive)
(run-with-idle-timer
0.01 nil
(lambda ()
(message "Warning: default bindings are being changed to C-n and C-p"))))
(message "Warning: default bindings are being changed to M-h and M-g"))))
(defun company-init-backend (backend)
(and (symbolp backend)
@@ -974,12 +979,16 @@ asynchronous call into synchronous.")
(defvar company-lighter '(" "
(company-candidates
(:eval
(if (consp company-backend)
(when company-selection
(company--group-lighter (nth company-selection
company-candidates)
company-lighter-base))
(symbol-name company-backend)))
(cond
((consp company-backend)
(when company-selection
(company--group-lighter (nth company-selection
company-candidates)
company-lighter-base)))
((symbolp company-backend)
(symbol-name company-backend))
((functionp company-backend)
"company-<lambda>")))
company-lighter-base))
"Mode line lighter for Company.
@@ -1045,8 +1054,20 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
(const :tag "Except" not)
(repeat :inline t (symbol :tag "mode")))))
(defcustom company-global-minibuffer t
"Non-nil to enable `company-mode' in the minibuffer.
The value can be t (meaning only enable if the minibuffer has a local
`completion-at-point-functions' value) or a custom predicate function.
The overlay based popup is not supported, completion won't start in
minibuffer if it's in configured frontends: use `company-childframe'."
:type 'boolean)
;;;###autoload
(define-globalized-minor-mode global-company-mode company-mode company-mode-on)
(define-globalized-minor-mode global-company-mode company-mode company-mode-on
(if global-company-mode
(add-hook 'minibuffer-setup-hook #'company--minibuffer-on 100)
(remove-hook 'minibuffer-setup-hook #'company--minibuffer-on)))
(defun company-mode-on ()
(when (and (not (or noninteractive (eq (aref (buffer-name) 0) ?\s)))
@@ -1057,6 +1078,14 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
(t (memq major-mode company-global-modes))))
(company-mode 1)))
(defun company--minibuffer-on ()
(when (and company-global-minibuffer
(not (try-completion "company-pseudo-tooltip" company-frontends))
(if (eq company-global-minibuffer t)
(local-variable-p 'completion-at-point-functions)
(funcall company-global-minibuffer)))
(company-mode 1)))
(defsubst company-assert-enabled ()
(unless company-mode
(company-uninstall-map)
@@ -1955,6 +1984,7 @@ end of the match."
(event . "symbol-event.svg")
(field . "symbol-field.svg")
(file . "symbol-file.svg")
(filter . "filter.svg")
(folder . "folder.svg")
(interface . "symbol-interface.svg")
(keyword . "symbol-keyword.svg")
@@ -1965,6 +1995,7 @@ end of the match."
(operator . "symbol-operator.svg")
(property . "symbol-property.svg")
(reference . "references.svg")
(search . "search.svg")
(snippet . "symbol-snippet.svg")
(string . "symbol-string.svg")
(struct . "symbol-structure.svg")
@@ -2068,6 +2099,7 @@ end of the match."
(enum "e" font-lock-builtin-face)
(field "f" font-lock-variable-name-face)
(file "f" font-lock-string-face)
(filter "!" minibuffer-prompt)
(folder "d" font-lock-doc-face)
(interface "i" font-lock-type-face)
(keyword "k" font-lock-keyword-face)
@@ -2078,6 +2110,7 @@ end of the match."
(operator "o" font-lock-comment-delimiter-face)
(property "p" font-lock-variable-name-face)
(reference "r" font-lock-doc-face)
(search "q" minibuffer-prompt)
(snippet "S" font-lock-string-face)
(string "s" font-lock-string-face)
(struct "%" font-lock-variable-name-face)
@@ -2235,7 +2268,7 @@ Searches for each in the currently visible part of the current buffer and
prioritizes the matches according to `company-occurrence-weight-function'.
The rest of the list is appended unchanged.
Keywords and function definition names are ignored."
(let* ((w-start (window-start))
(let* ((w-start (max (window-start) (field-beginning)))
(w-end (window-end))
(start-point (point))
occurs
@@ -2659,7 +2692,12 @@ For more details see `company-insertion-on-trigger' and
(cancel-timer company-timer)
(setq company-timer nil))
(company-echo-cancel t)
(company-uninstall-map))
(unless (memq this-original-command
'(describe-key
describe-key-briefly
describe-map
describe-bindings))
(company-uninstall-map)))
(defun company-post-command ()
(when (and company-candidates
@@ -2727,7 +2765,7 @@ For more details see `company-insertion-on-trigger' and
;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom company-search-regexp-function #'regexp-quote
(defcustom company-search-regexp-function #'company-search-words-in-any-order-regexp
"Function to construct the search regexp from input.
It's called with one argument, the current search input. It must return
either a regexp without groups, or one where groups don't intersect and
@@ -2738,10 +2776,13 @@ each one wraps a part of the input string."
(const :tag "Words separated with spaces, in any order"
company-search-words-in-any-order-regexp)
(const :tag "All characters in given order, with anything in between"
company-search-flex-regexp)))
company-search-flex-regexp)
(const :tag "Space separated words in any order, all chars inside a word with anything in between"
company-search-flex-words-in-any-order-regexp)))
(defvar-local company-search-string "")
;; FIXME: Delete later.
(defvar company-search-lighter '(" "
(company-search-filtering "Filter" "Search")
": \""
@@ -2771,12 +2812,23 @@ each one wraps a part of the input string."
(defun company-search-flex-regexp (input)
(if (zerop (length input))
""
(concat (regexp-quote (string (aref input 0)))
(concat (format "\\(%s\\)" (regexp-quote (string (aref input 0))))
(mapconcat (lambda (c)
(concat "[^" (string c) "]*"
(regexp-quote (string c))))
(format "\\(%s\\)"
(regexp-quote (string c)))))
(substring input 1) ""))))
(defun company-search-flex-words-in-any-order-regexp (input)
(let* ((words (mapcar (lambda (word) (format "\\(?:%s\\)"
(company-search-flex-regexp word)))
(split-string input " +" t)))
(permutations (company--permutations words)))
(mapconcat (lambda (words)
(mapconcat #'identity words ".*"))
permutations
"\\|")))
(defun company--permutations (lst)
(if (not lst)
'(nil)
@@ -2827,9 +2879,16 @@ each one wraps a part of the input string."
(let* ((selection (or company-selection 0))
(pos (company--search new (nthcdr selection company-candidates))))
(if (null pos)
(let ((pos (company--search new (nthcdr (- company-candidates-length
selection)
(reverse company-candidates)))))
(if (null pos)
(ding)
(setq company-search-string new)
(company-set-selection (- selection pos 1) t)))
(ding)
(setq company-search-string new)
(company-set-selection (+ selection pos) t))))
(setq company-search-string new)
(company-set-selection (+ selection pos) t))))
(defun company--search-assert-input ()
(company--search-assert-enabled)
@@ -2842,7 +2901,7 @@ each one wraps a part of the input string."
(company--search-assert-input)
(let* ((selection (or company-selection 0))
(pos (company--search company-search-string
(cdr (nthcdr selection company-candidates)))))
(cdr (nthcdr selection company-candidates)))))
(if (null pos)
(ding)
(company-set-selection (+ selection pos 1) t))))
@@ -2941,7 +3000,7 @@ each one wraps a part of the input string."
"Search mode for completion candidates.
Don't start this directly, use `company-search-candidates' or
`company-filter-candidates'."
:lighter company-search-lighter
:lighter nil
(if company-search-mode
(if (company-manual-begin)
(progn
@@ -2989,8 +3048,8 @@ uses the search string to filter the completion candidates."
This works the same way as `company-search-candidates' immediately
followed by `company-search-toggle-filtering'."
(interactive)
(company-search-mode 1)
(setq company-search-filtering t))
(setq company-search-filtering t)
(company-search-mode 1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3527,6 +3586,25 @@ from the candidates list.")
(let ((win (display-buffer doc-buffer t)))
(set-window-start win (if start start (point-min)))))))
(defun company--fake-capf-complete-common (&rest _)
(company-complete-common)
(list (point) (point) nil))
(defun company-indent-for-tab-command (&optional arg)
"Like `indent-for-tab-command' which see but calls `company-complete-common'
instead of `completion-at-point' as the fallback. That only happens when
`tab-always-indent' is `complete', and only when reindentation was a no-op."
(interactive)
(unwind-protect
(progn
(add-hook 'completion-at-point-functions
#'company--fake-capf-complete-common
nil t)
(funcall-interactively #'indent-for-tab-command arg))
(remove-hook 'completion-at-point-functions
#'company--fake-capf-complete-common
t)))
(defun company-show-doc-buffer (&optional toggle-auto-update)
"Show the documentation buffer for the selection.
With a prefix argument TOGGLE-AUTO-UPDATE, toggle the value of
@@ -3539,6 +3617,12 @@ automatically show the documentation buffer for each selection."
(company--show-doc-buffer)))
(put 'company-show-doc-buffer 'company-keep t)
(defun company--show-doc-buffer-and-warn (&optional toggle-auto-update)
(interactive "P")
(company--warn-changed-binding)
(company-show-doc-buffer toggle-auto-update))
(put 'company--show-doc-buffer-and-warn 'company-keep t)
(defun company-show-location ()
"Temporarily display a buffer showing the selected candidate in context."
(interactive)
@@ -3560,6 +3644,12 @@ automatically show the documentation buffer for each selection."
(set-window-start nil (point)))))))
(put 'company-show-location 'company-keep t)
(defun company--show-location-and-warn ()
(interactive)
(company--warn-changed-binding)
(company-show-location))
(put 'company--show-location-and-warn 'company-keep t)
;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-callback nil)
@@ -4055,6 +4145,8 @@ but adjust the expected values appropriately."
previous
remainder
scrollbar-bounds)
(when company-search-mode
(cl-decf limit))
;; Maybe clear old offset.
(when (< len (+ company-tooltip-offset limit))
@@ -4131,7 +4223,13 @@ but adjust the expected values appropriately."
width))))
(when company-tooltip-width-grow-only
(setq width (max company--tooltip-current-width width))
(setq width (max
(min
(if (numberp company-tooltip-width-grow-only)
company-tooltip-width-grow-only
most-positive-fixnum)
company--tooltip-current-width)
width))
(setq company--tooltip-current-width width))
(let ((items (nreverse items))
@@ -4169,6 +4267,10 @@ but adjust the expected values appropriately."
(when remainder
(push (company--scrollpos-line remainder width left-margin-size) new))
(when company-search-mode
(push (company--search-line width right-margin)
new))
(cons
left-margin-size
(nreverse new)))))
@@ -4221,6 +4323,29 @@ Value of SELECTED determines the added face."
'company-tooltip-quick-access-selection
'company-tooltip-quick-access)))
(defun company--search-line (width right-margin)
(let* ((company-backend (lambda (command &rest _)
(and (eq command 'kind)
(if company-search-filtering
'filter
'search))))
(left (if company-format-margin-function
(funcall company-format-margin-function "" nil)
(concat
(company-space-string company-tooltip-margin)
(format "%s: " (company-call-backend 'kind)))))
(line (concat
company-search-string))
(width (+ (company--string-width left) width (length right-margin))))
(unless (display-graphic-p) (cl-incf width))
(setq line (company-safe-substring (concat left
(propertize
company-search-string
'face 'underline))
0 width))
(add-face-text-property 0 width 'company-tooltip nil line)
line))
;; show
(defvar-local company-pseudo-tooltip-overlay nil)
@@ -4244,7 +4369,10 @@ Value of SELECTED determines the added face."
Returns a negative number if the tooltip should be displayed above point."
(let* ((lines (company--row))
(below (- (company--window-height) 1 lines)))
(if (and (< below (min company-tooltip-minimum company-candidates-length))
(if (and (< below (min company-tooltip-minimum
(if company-search-mode
(1+ company-candidates-length)
company-candidates-length)))
(> lines below))
(- (max 3 (min company-tooltip-limit lines)))
(max 3 (min company-tooltip-limit below)))))
@@ -4468,6 +4596,9 @@ Delay is determined by `company-tooltip-idle-delay'."
(defvar-local company-preview-overlay nil)
(defun company-preview-show-at-point (pos completion &optional boundaries)
(when (minibufferp)
(company-echo-hide))
(company-preview-hide)
(let* ((boundaries (or boundaries (company--boundaries completion)))
@@ -4528,6 +4659,8 @@ Delay is determined by `company-tooltip-idle-delay'."
(let ((ov company-preview-overlay))
(overlay-put ov (if (> end beg) 'display 'after-string)
completion)
;; Show before minibuffer-message-overlay if there.
(overlay-put ov 'priority 1101)
(overlay-put ov 'window (selected-window))))))
(defun company-preview-hide ()
@@ -4607,9 +4740,31 @@ Delay is determined by `company-tooltip-idle-delay'."
(defun company-echo-show (&optional getter)
(let ((last-msg company-echo-last-msg)
(message-log-max nil)
(preview-o company-preview-overlay)
(message-truncate-lines company-echo-truncate-lines))
(when getter
(setq company-echo-last-msg (funcall getter)))
(when-let* ((mini-window (and company-echo-truncate-lines
(active-minibuffer-window)))
(posn (posn-at-point
(with-current-buffer (window-buffer mini-window)
(max (point-min)
(1- (point-max))))
mini-window))
(max-len (max 0
(- (window-width mini-window)
(car
(posn-col-row posn))
(if preview-o
(company--string-width
(or
(overlay-get preview-o 'display)
(overlay-get preview-o 'after-string)
""))
0)
5))))
(when (> (length company-echo-last-msg) max-len)
(setq company-echo-last-msg (substring company-echo-last-msg 0 max-len))))
;; Avoid modifying the echo area if we don't have anything to say, and we
;; didn't put the previous message there (thus there's nothing to clear),
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62816#20
@@ -4695,8 +4850,7 @@ Delay is determined by `company-tooltip-idle-delay'."
(defun company-echo-hide ()
(unless (string-empty-p company-echo-last-msg)
(setq company-echo-last-msg "")
(company-echo-show)))
(company-echo-show #'ignore)))
(defun company-echo-frontend (command)
"`company-mode' frontend showing the candidates in the echo area."
@@ -4713,9 +4867,35 @@ Delay is determined by `company-tooltip-idle-delay'."
(defun company-echo-metadata-frontend (command)
"`company-mode' frontend showing the documentation in the echo area."
(pcase command
(`pre-command
(when (and (> company-echo-delay 0)
(or (not (minibufferp))
(memq this-command
'(self-insert-command
delete-backward-char
company-select-next
company-select-previous
company-select-next-or-abort
company-select-previous-or-abort
company-next-page
company-previous-page
company-search-repeat-forward
company-search-repeat-backward
company-complete-common-or-cycle))))
(company-echo-show)))
(`post-command (company-echo-show-soon 'company-fetch-metadata))
(`unhide (company-echo-show))
(`hide (company-echo-hide))))
(eldoc-add-command-completions "company-")
(defun company--eldoc-no-inteference-p ()
(or (not company-candidates)
(member company-echo-last-msg '(nil ""))))
(advice-add #'eldoc-display-message-no-interference-p
:after-while
#'company--eldoc-no-inteference-p)
(provide 'company)
;;; company.el ends here
lisp/company/company.info
+43 -41
View File
@@ -9,7 +9,8 @@ Copyright © 2021-2024 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
Version 1.3 or any later version published by the Free Software
Foundation.
Foundation, with no Invariant Sections, no Front-Cover Texts, and
no Back-Cover Texts.
INFO-DIR-SECTION Emacs misc features
START-INFO-DIR-ENTRY
* Company: (company). A modular text completion framework.
@@ -35,7 +36,8 @@ Copyright © 2021-2024 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
Version 1.3 or any later version published by the Free Software
Foundation.
Foundation, with no Invariant Sections, no Front-Cover Texts, and
no Back-Cover Texts.
* Menu:
@@ -1773,45 +1775,45 @@ Concept Index

Tag Table:
Node: Top573
Node: Overview1999
Node: Terminology2407
Node: Structure3710
Node: Getting Started5200
Node: Installation5478
Node: Initial Setup5861
Node: Usage Basics6709
Node: Commands7683
Ref: Commands-Footnote-110079
Node: Customization10246
Node: Customization Interface10718
Node: Configuration File11251
Ref: company-selection-wrap-around13565
Node: Frontends16054
Node: Tooltip Frontends17023
Ref: Tooltip Frontends-Footnote-127719
Node: Preview Frontends27956
Ref: Preview Frontends-Footnote-129214
Node: Echo Frontends29341
Node: Candidates Search30870
Node: Filter Candidates32202
Node: Quick Access a Candidate32982
Node: Backends34600
Node: Backends Usage Basics35630
Ref: Backends Usage Basics-Footnote-137062
Node: Grouped Backends37146
Node: Package Backends38657
Node: Code Completion39584
Node: Text Completion45101
Node: File Name Completion49525
Node: Template Expansion51071
Node: Candidates Post-Processing51790
Node: Troubleshooting54367
Node: Index56038
Node: Key Index56201
Node: Variable Index57700
Node: Function Index62553
Node: Concept Index67253
Node: Top653
Node: Overview2159
Node: Terminology2567
Node: Structure3870
Node: Getting Started5360
Node: Installation5638
Node: Initial Setup6021
Node: Usage Basics6869
Node: Commands7843
Ref: Commands-Footnote-110239
Node: Customization10406
Node: Customization Interface10878
Node: Configuration File11411
Ref: company-selection-wrap-around13725
Node: Frontends16214
Node: Tooltip Frontends17183
Ref: Tooltip Frontends-Footnote-127879
Node: Preview Frontends28116
Ref: Preview Frontends-Footnote-129374
Node: Echo Frontends29501
Node: Candidates Search31030
Node: Filter Candidates32362
Node: Quick Access a Candidate33142
Node: Backends34760
Node: Backends Usage Basics35790
Ref: Backends Usage Basics-Footnote-137222
Node: Grouped Backends37306
Node: Package Backends38817
Node: Code Completion39744
Node: Text Completion45261
Node: File Name Completion49685
Node: Template Expansion51231
Node: Candidates Post-Processing51950
Node: Troubleshooting54527
Node: Index56198
Node: Key Index56361
Node: Variable Index57860
Node: Function Index62713
Node: Concept Index67413

End Tag Table
lisp/company/icons/vscode-dark/filter.svg
+3
View File
@@ -0,0 +1,3 @@
<svg width="16" height="16" viewBox="0 0 16 16" fill="none" xmlns="http://www.w3.org/2000/svg">
<path fill-rule="evenodd" clip-rule="evenodd" d="M15 2V3.66963L10 8.42874V14H6V8.42874L1 3.66963V2H15ZM7 8V13H9V8L14 3.24089V3H2V3.24089L7 8Z" fill="#C5C5C5"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 263 B

lisp/company/icons/vscode-dark/search.svg
+3
View File
@@ -0,0 +1,3 @@
<svg width="16" height="16" viewBox="0 0 24 24" fill="none" xmlns="http://www.w3.org/2000/svg">
<path d="M15.25 1.02546e-06C13.6605 -0.000791296 12.1046 0.457574 10.7694 1.32007C9.43422 2.18256 8.37657 3.4124 7.72375 4.8617C7.07094 6.31099 6.85077 7.91801 7.0896 9.4895C7.32843 11.061 8.01604 12.5301 9.06995 13.72L1 22.88L2.12 23.88L10.17 14.76C11.2055 15.5693 12.4192 16.1196 13.7103 16.365C15.0014 16.6104 16.3325 16.5437 17.5927 16.1707C18.8528 15.7976 20.0055 15.1288 20.955 14.2201C21.9044 13.3114 22.623 12.1891 23.0509 10.9465C23.4789 9.70396 23.6038 8.37703 23.4153 7.07642C23.2267 5.77581 22.7302 4.53915 21.967 3.46924C21.2039 2.39933 20.1962 1.52711 19.0278 0.925416C17.8595 0.323719 16.5642 0.00991516 15.25 0.0100108V1.02546e-06ZM15.25 15C13.915 15 12.6099 14.6041 11.4999 13.8624C10.3898 13.1207 9.52469 12.0665 9.01379 10.8331C8.5029 9.59973 8.36919 8.24248 8.62964 6.93311C8.89009 5.62373 9.53305 4.42106 10.4771 3.47705C11.4211 2.53305 12.6237 1.89009 13.9331 1.62964C15.2425 1.36919 16.5997 1.5029 17.8331 2.01379C19.0665 2.52469 20.1207 3.38985 20.8624 4.49988C21.6041 5.60991 22 6.91498 22 8.25C22 10.0402 21.2888 11.7571 20.0229 13.023C18.7571 14.2888 17.0402 15 15.25 15Z" fill="#C5C5C5"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 1.2 KiB

lisp/company/icons/vscode-light/filter.svg
+3
View File
@@ -0,0 +1,3 @@
<svg width="16" height="16" viewBox="0 0 16 16" fill="none" xmlns="http://www.w3.org/2000/svg">
<path fill-rule="evenodd" clip-rule="evenodd" d="M15.0002 2V3.66963L10.0002 8.42874V14H6.00024V8.42874L1.00024 3.66963V2H15.0002ZM7.00024 8V13H9.00024V8L14.0002 3.24089V3H2.00024V3.24089L7.00024 8Z" fill="#424242"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 319 B

lisp/company/icons/vscode-light/search.svg
+3
View File
@@ -0,0 +1,3 @@
<svg width="16" height="16" viewBox="0 0 24 24" fill="none" xmlns="http://www.w3.org/2000/svg">
<path d="M15.2502 1.02546e-06C13.6607 -0.000791296 12.1048 0.457574 10.7697 1.32007C9.43447 2.18256 8.37681 3.4124 7.724 4.8617C7.07118 6.31099 6.85102 7.91801 7.08984 9.4895C7.32867 11.061 8.01628 12.5301 9.07019 13.72L1.00024 22.88L2.12024 23.88L10.1703 14.76C11.2057 15.5693 12.4195 16.1196 13.7106 16.365C15.0017 16.6104 16.3328 16.5437 17.5929 16.1707C18.853 15.7976 20.0058 15.1288 20.9552 14.2201C21.9046 13.3114 22.6232 12.1891 23.0511 10.9465C23.4791 9.70396 23.6041 8.37703 23.4155 7.07642C23.227 5.77581 22.7304 4.53915 21.9673 3.46924C21.2041 2.39933 20.1964 1.52711 19.0281 0.925416C17.8597 0.323719 16.5644 0.00991516 15.2502 0.0100108V1.02546e-06ZM15.2502 15C13.9152 15 12.6102 14.6041 11.5001 13.8624C10.3901 13.1207 9.52493 12.0665 9.01404 10.8331C8.50315 9.59973 8.36943 8.24248 8.62988 6.93311C8.89033 5.62373 9.53329 4.42106 10.4773 3.47705C11.4213 2.53305 12.624 1.89009 13.9333 1.62964C15.2427 1.36919 16.6 1.5029 17.8334 2.01379C19.0668 2.52469 20.121 3.38985 20.8627 4.49988C21.6044 5.60991 22.0002 6.91498 22.0002 8.25C22.0002 10.0402 21.2891 11.7571 20.0232 13.023C18.7573 14.2888 17.0405 15 15.2502 15Z" fill="#424242"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 1.2 KiB

lisp/compat/NEWS.org
+38 -10
View File
@@ -1,7 +1,38 @@
#+link: compat-srht https://todo.sr.ht/~pkal/compat/
#+link: compat-gh https://github.com/emacs-compat/compat/issues/
#+options: toc:nil num:nil author:nil
* Release of "Compat" Version 31.0.0.1
- compat-31: Improve =with-work-buffer= implementation.
(Release <2026-05-03 Sun>)
* Release of "Compat" Version 31.0.0.0
- compat-28: New pcase pattern =cl-type=.
- compat-29: Add =string-glyph-compose= and =string-glyph-decompose=.
- compat-31: New macros =static-when= and =static-unless=.
- compat-31: New functions =oddp= and =evenp=.
- compat-31: New functions =minusp= and =plusp=.
- compat-31: New macros =incf= and =decf=.
- compat-31: New function =color-blend=.
- compat-31: New function =completion-table-with-metadata=.
- compat-31: New function =completion-list-candidate-at-point=.
- compat-31: New macro =with-work-buffer=.
- compat-31: New function =unbuttonize-region=.
- compat-31: New extended function =seconds-to-string=.
- compat-31: New function =hash-table-contains-p=.
- compat-31: New function =remove-display-text-property=.
- compat-31: New functions =drop-while=, =take-while=, =member-if=, =any=, =all=.
- compat-31: New function =set-local=.
- compat-31: New function =ensure-proper-list=.
- compat-31: New error API functions =error-type-p=, =error-has-type-p=, =error-type=
and =error-slot-value=.
- Drop support for Emacs 24.x. Emacs 25.1 is required now. In case
Emacs 24.x support is still needed, Compat 30 can be used.
(Release <2026-05-01 Fri>)
* Release of "Compat" Version 30.1.0.1
- compat-28: Fix =named-let= tail recursion.
@@ -275,7 +306,7 @@
* Release of "Compat" Version 28.1.2.2
This is a minor release that hopes to address [[compat-srht:7]].
This is a minor release.
(Release <2022-08-25 Thu>)
@@ -297,8 +328,8 @@ include much more documentation that had been the case previously.
The main change of this release has been the major simplification of
Compat's initialisation system, improving the situation around issues
people had been reporting ([[compat-srht:4]], once again) with unconventional
or unpopular packaging systems.
people had been reporting with unconventional or unpopular packaging
systems.
In addition to this, the following functional changes have been made:
@@ -314,7 +345,6 @@ Minor improvements to manual are also part of this release.
This release just contains a hot-fix for an issue introduced in the
last version, where compat.el raises an error during byte compilation.
See [[compat-srht:4]].
(Release <2022-06-19 Sun>)
@@ -322,11 +352,9 @@ See [[compat-srht:4]].
Two main changes have necessitated a new patch release:
1. Fix issues related to the loading of compat when uncompiled. See
[[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this thread]] for more details on the problem.
1. Fix issues related to the loading of compat when uncompiled.
2. Fix issues related to the loading of compat on old pre-releases
(think of 28.0.50). See [[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this thread]] for more details on the
problem.
(think of 28.0.50).
(Released <2022-06-22 Wed>)
@@ -334,7 +362,7 @@ Two main changes have necessitated a new patch release:
This is a minor release fixing a bug in =json-serialize=, that could
cause unintended side-effects, not related to packages using Compat
directly (see [[compat-srht:2]]).
directly.
(Released <2022-05-05 Thu>)
lisp/compat/compat-25.el
-260
View File
@@ -1,260 +0,0 @@
;;; compat-25.el --- Functionality added in Emacs 25.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Functionality added in Emacs 25.1, needed by older Emacs versions.
;;; Code:
(eval-when-compile (load "compat-macs.el" nil t t))
(compat-version "25.1")
;;;; Defined in alloc.c
(compat-defun bool-vector (&rest objects) ;; <compat-tests:bool-vector>
"Return a new bool-vector with specified arguments as elements.
Allows any number of arguments, including zero.
usage: (bool-vector &rest OBJECTS)"
(let ((vec (make-bool-vector (length objects) nil))
(i 0))
(while objects
(when (car objects)
(aset vec i t))
(setq objects (cdr objects)
i (1+ i)))
vec))
;;;; Defined in editfns.c
(compat-defalias format-message format) ;; <compat-tests:format-message>
;;;; Defined in fileio.c
(compat-defun directory-name-p (name) ;; <compat-tests:directory-name-p>
"Return non-nil if NAME ends with a directory separator character."
(eq (eval-when-compile
(if (memq system-type '(cygwin windows-nt ms-dos))
?\\ ?/))
(aref name (1- (length name)))))
;;;; Defined in doc.c
(compat-defvar text-quoting-style nil ;; <compat-tests:text-quoting-style>
"Style to use for single quotes in help and messages.
The value of this variable determines substitution of grave accents
and apostrophes in help output (but not for display of Info
manuals) and in functions like `message' and `format-message', but not
in `format'.
The value should be one of these symbols:
`curve': quote with curved single quotes ‘like this’.
`straight': quote with straight apostrophes \\='like this\\='.
`grave': quote with grave accent and apostrophe \\=`like this\\=';
i.e., do not alter the original quote marks.
nil: like `curve' if curved single quotes are displayable,
and like `grave' otherwise. This is the default.
You should never read the value of this variable directly from a Lisp
program. Use the function `text-quoting-style' instead, as that will
compute the correct value for the current terminal in the nil case.")
;;;; Defined in simple.el
;; `save-excursion' behaved like `save-mark-and-excursion' before 25.1.
(compat-defalias save-mark-and-excursion save-excursion) ;; <compat-tests:save-mark-and-excursion>
(declare-function region-bounds nil) ;; Defined in compat-26.el
(compat-defun region-noncontiguous-p () ;; <compat-tests:region-noncontiguous-p>
"Return non-nil if the region contains several pieces.
An example is a rectangular region handled as a list of
separate contiguous regions for each line."
(let ((bounds (region-bounds))) (and (cdr bounds) bounds)))
;;;; Defined in subr.el
(compat-defun string-greaterp (string1 string2) ;; <compat-tests:string-greaterp>
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead."
(string-lessp string2 string1))
(compat-defmacro with-file-modes (modes &rest body) ;; <compat-tests:with-file-modes>
"Execute BODY with default file permissions temporarily set to MODES.
MODES is as for `set-default-file-modes'."
(declare (indent 1) (debug t))
(let ((umask (make-symbol "umask")))
`(let ((,umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes ,modes)
,@body)
(set-default-file-modes ,umask)))))
(compat-defmacro if-let (spec then &rest else) ;; <compat-tests:if-let>
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
binding value is nil. If all are non-nil return the value of
THEN, otherwise the last form in ELSE.
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
SYMBOL to the value of VALUEFORM. An element can additionally be
of the form (VALUEFORM), which is evaluated and checked for nil;
i.e. SYMBOL can be omitted if only the test result is of
interest. It can also be of the form SYMBOL, then the binding of
SYMBOL is checked for nil.
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
like \((SYMBOL SOMETHING)). This exists for backward compatibility
with an old syntax that accepted only one binding."
(declare (indent 2)
(debug ([&or (symbolp form)
(&rest [&or symbolp (symbolp form) (form)])]
body)))
(when (and (<= (length spec) 2) (not (listp (car spec))))
;; Adjust the single binding case
(setq spec (list spec)))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var spec)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(if (cdr var) (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(if ,(caar list) ,then ,@else))))
(compat-defmacro when-let (spec &rest body) ;; <compat-tests:when-let>
"Bind variables according to SPEC and conditionally evaluate BODY.
Evaluate each binding in turn, stopping if a binding value is nil.
If all are non-nil, return the value of the last form in BODY.
The variable list SPEC is the same as in `if-let'."
(declare (indent 1) (debug if-let))
(list 'if-let spec (macroexp-progn body)))
;;;; Defined in subr-x.el
(compat-defun hash-table-empty-p (hash-table) ;; <compat-tests:hash-table-empty-p>
"Check whether HASH-TABLE is empty (has 0 elements)."
(zerop (hash-table-count hash-table)))
(compat-defmacro thread-first (&rest forms) ;; <compat-tests:thread-first>
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
(let ((body (car forms)))
(dolist (form (cdr forms))
(when (symbolp form)
(setq form (list form)))
(setq body (append (list (car form))
(list body)
(cdr form))))
body))
(compat-defmacro thread-last (&rest forms) ;; <compat-tests:thread-last>
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
(declare (indent 1) (debug thread-first))
(let ((body (car forms)))
(dolist (form (cdr forms))
(when (symbolp form)
(setq form (list form)))
(setq body (append form (list body))))
body))
;;;; Defined in macroexp.el
(compat-defun macroexp-parse-body (body) ;; <compat-tests:macroexp-parse-body>
"Parse a function BODY into (DECLARATIONS . EXPS)."
(let ((decls ()))
(while (and (cdr body)
(let ((e (car body)))
(or (stringp e)
(memq (car-safe e)
'(:documentation declare interactive cl-declare)))))
(push (pop body) decls))
(cons (nreverse decls) body)))
(compat-defun macroexp-quote (v) ;; <compat-tests:macroexp-quote>
"Return an expression E such that `(eval E)' is V.
E is either V or (quote V) depending on whether V evaluates to
itself or not."
(if (and (not (consp v))
(or (keywordp v)
(not (symbolp v))
(memq v '(nil t))))
v
(list 'quote v)))
(compat-defun macroexpand-1 (form &optional environment) ;; <compat-tests:macroexpand-1>
"Perform (at most) one step of macro expansion."
(cond
((consp form)
(let* ((head (car form))
(env-expander (assq head environment)))
(if env-expander
(if (cdr env-expander)
(apply (cdr env-expander) (cdr form))
form)
(if (not (and (symbolp head) (fboundp head)))
form
(let ((def (autoload-do-load (symbol-function head) head 'macro)))
(cond
;; Follow alias, but only for macros, otherwise we may end up
;; skipping an important compiler-macro (e.g. cl--block-wrapper).
((and (symbolp def) (macrop def)) (cons def (cdr form)))
((not (consp def)) form)
(t
(if (eq 'macro (car def))
(apply (cdr def) (cdr form))
form))))))))
(t form)))
;;;; Defined in minibuffer.el
(compat-defun completion--category-override (category tag) ;; <compat-tests:completion-metadata-get>
"Return completion category override for CATEGORY and TAG."
(assq tag (cdr (assq category completion-category-overrides))))
(provide 'compat-25)
;;; compat-25.el ends here
lisp/compat/compat-26.el
+3 -7
View File
@@ -1,6 +1,6 @@
;;; compat-26.el --- Functionality added in Emacs 26.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -67,11 +67,7 @@ SEQUENCE may be a list, a vector, a boolean vector, or a string."
Value is a list of one or more cons cells of the form (START . END).
It will have more than one cons cell when the region is non-contiguous,
see `region-noncontiguous-p' and `extract-rectangle-bounds'."
(if (eval-when-compile (< emacs-major-version 25))
;; FIXME: The `region-extract-function' of Emacs 24 has no support for the
;; bounds argument.
(list (cons (region-beginning) (region-end)))
(funcall region-extract-function 'bounds)))
(funcall region-extract-function 'bounds))
;;;; Defined in subr.el
@@ -108,7 +104,7 @@ If you just want to check `major-mode', use `derived-mode-p'."
(compat-defun alist-get (key alist &optional default remove testfn) ;; <compat-tests:alist-get>
"Handle optional argument TESTFN."
:extended "25.1"
:extended t
(ignore remove)
(let ((x (if (not testfn)
(assq key alist)
lisp/compat/compat-27.el
+1 -1
View File
@@ -1,6 +1,6 @@
;;; compat-27.el --- Functionality added in Emacs 27.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
lisp/compat/compat-28.el
+9 -1
View File
@@ -1,6 +1,6 @@
;;; compat-28.el --- Functionality added in Emacs 28.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -853,5 +853,13 @@ function will never return nil."
:type-error "This field should contain a nonnegative integer"
:match-alternatives '(natnump)))
;;;; Defined in pcase.el
(compat-guard t ;; <compat-tests:pcase-cl-type>
(pcase-defmacro cl-type (type)
"Pcase pattern that matches objects of TYPE.
TYPE is a type descriptor as accepted by `cl-typep', which see."
`(pred (lambda (x) (cl-typep x ',type)))))
(provide 'compat-28)
;;; compat-28.el ends here
lisp/compat/compat-29.el
+33 -41
View File
@@ -1,6 +1,6 @@
;;; compat-29.el --- Functionality added in Emacs 29.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -584,47 +584,15 @@ be marked unmodified, effectively ignoring those changes."
(equal ,hash (buffer-hash)))
(restore-buffer-modified-p nil))))))))
(compat-defun add-display-text-property (start end prop value ;; <compat-tests:add-display-text-property>
&optional object)
"Add display property PROP with VALUE to the text from START to END.
If any text in the region has a non-nil `display' property, those
properties are retained.
(compat-defun add-display-text-property (start end spec value &optional object) ;; <compat-tests:add-display-text-property>
"Add the display specification (SPEC VALUE) to the text from START to END.
If any text in the region has a non-nil `display' property, the existing
display specifications are retained.
If OBJECT is non-nil, it should be a string or a buffer. If nil,
this defaults to the current buffer."
(let ((sub-start start)
(sub-end 0)
disp)
(while (< sub-end end)
(setq sub-end (next-single-property-change sub-start 'display object
(if (stringp object)
(min (length object) end)
(min end (point-max)))))
(if (not (setq disp (get-text-property sub-start 'display object)))
;; No old properties in this range.
(put-text-property sub-start sub-end 'display (list prop value)
object)
;; We have old properties.
(let ((vector nil))
;; Make disp into a list.
(setq disp
(cond
((vectorp disp)
(setq vector t)
(append disp nil))
((not (consp (car disp)))
(list disp))
(t
disp)))
;; Remove any old instances.
(when-let ((old (assoc prop disp)))
(setq disp (delete old disp)))
(setq disp (cons (list prop value) disp))
(when vector
(setq disp (vconcat disp)))
;; Finally update the range.
(put-text-property sub-start sub-end 'display disp object)))
(setq sub-start sub-end))))
OBJECT is either a string or a buffer to add the specification to.
If omitted, OBJECT defaults to the current buffer."
(declare-function add-remove--display-text-property "compat-31")
(add-remove--display-text-property start end spec value object))
(compat-defmacro while-let (spec &rest body) ;; <compat-tests:while-let>
"Bind variables according to SPEC and conditionally evaluate BODY.
@@ -641,6 +609,30 @@ The variable list SPEC is the same as in `if-let*'."
,@body)
(throw ',done nil))))))
;;;; Defined in ucs-normalize.el
(compat-defun string-glyph-compose (string) ;; <compat-tests:string-glyph-compose>
"Compose STRING according to the Unicode NFC.
This returns a new string obtained by canonical decomposition
of STRING (see `ucs-normalize-NFC-string') followed by canonical
composition, a.k.a. the \"Unicode Normalization Form C\" of STRING.
For instance:
(string-glyph-compose \"Å\") => \"Å\""
(unless (fboundp 'ucs-normalize-NFC-string)
(require 'ucs-normalize))
(ucs-normalize-NFC-string string))
(compat-defun string-glyph-decompose (string) ;; <compat-tests:string-glyph-decompose>
"Decompose STRING according to the Unicode NFD.
This returns a new string that is the canonical decomposition of STRING,
a.k.a. the \"Unicode Normalization Form D\" of STRING. For instance:
(ucs-normalize-NFD-string \"Å\") => \"Å\""
(unless (fboundp 'ucs-normalize-NFD-string)
(require 'ucs-normalize))
(ucs-normalize-NFD-string string))
;;;; Defined in files.el
(compat-defun directory-abbrev-make-regexp (directory) ;; <compat-tests:directory-abbrev-make-regexp>
lisp/compat/compat-30.el
+6 -20
View File
@@ -1,6 +1,6 @@
;;; compat-30.el --- Functionality added in Emacs 30 -*- lexical-binding: t; -*-
;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
;; Copyright (C) 2023-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -431,7 +431,7 @@ The following arguments are defined:
For compatibility, the calling convention (sort SEQ LESSP) can also be used;
in this case, sorting is always done in-place."
:extended t
(let ((in-place t) (reverse nil) (orig-seq seq))
(let ((in-place t) (reverse nil))
(when (or (not lessp) rest)
(setq
rest (if lessp (cons lessp rest) rest)
@@ -442,24 +442,10 @@ in this case, sorting is always done in-place."
(if key
(lambda (a b) (funcall < (funcall key a) (funcall key b)))
<))
seq (if (or (and (eval-when-compile (< emacs-major-version 25)) (vectorp orig-seq))
in-place)
seq
(copy-sequence seq))))
;; Emacs 24 does not support vectors. Convert to list.
(when (and (eval-when-compile (< emacs-major-version 25)) (vectorp orig-seq))
(setq seq (append seq nil)))
(setq seq (if reverse
(nreverse (sort (nreverse seq) lessp))
(sort seq lessp)))
;; Emacs 24: Convert back to vector.
(if (and (eval-when-compile (< emacs-major-version 25)) (vectorp orig-seq))
(if in-place
(cl-loop for i from 0 for x in seq
do (aset orig-seq i x)
finally return orig-seq)
(apply #'vector seq))
seq)))
seq (if in-place seq (copy-sequence seq))))
(if reverse
(nreverse (sort (nreverse seq) lessp))
(sort seq lessp))))
;;;; Defined in mule-cmds.el
lisp/compat/compat-31.el
+416
View File
@@ -0,0 +1,416 @@
;;; compat-31.el --- Functionality added in Emacs 31 -*- lexical-binding: t; -*-
;; Copyright (C) 2025-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Functionality added in Emacs 31, needed by older Emacs versions.
;;; Code:
(eval-when-compile (load "compat-macs.el" nil t t))
(compat-require compat-30 "30.1")
;; TODO Update to 31.1 as soon as the Emacs emacs-31 branch version bumped
(compat-version "31.0.50")
;;;; Defined in subr.el
(compat-defun error-type-p (symbol) ;; <compat-tests:error-api>
"Return non-nil if SYMBOL is a condition type."
(get symbol 'error-conditions))
(compat-defun error-has-type-p (error condition) ;; <compat-tests:error-api>
"Return non-nil if ERROR is of type CONDITION (or a subtype of it)."
(unless (let ((type (car-safe error)))
(and type (symbolp type) (listp (cdr error))
(error-type-p type)))
(signal 'wrong-type-argument (list error)))
(or (eq condition t)
(memq condition (get (car error) 'error-conditions))))
(compat-defalias error-type car ;; <compat-tests:error-api>
"Return the symbol which represents the type of ERROR.
\n(fn ERROR)")
(compat-defalias error-slot-value elt ;; <compat-tests:error-api>
"Access the SLOT of object ERROR.
Slots are specified by position, and slot 0 is the error symbol.
\n(fn ERROR SLOT)")
(compat-defun ensure-proper-list (object) ;; <compat-tests:ensure-proper-list>
"Return OBJECT as a list.
If OBJECT is already a proper list, return OBJECT itself. If it's not a
proper list, return a one-element list containing OBJECT.
`ensure-list' is usually preferable because that function runs in
constant time, but this one has to traverse the whole of OBJECT."
(declare (side-effect-free error-free))
(if (proper-list-p object)
object
(list object)))
(compat-defun set-local (variable value) ;; <compat-tests:set-local>
"Make VARIABLE buffer local and set it to VALUE."
(set (make-local-variable variable) value))
(compat-defun take-while (pred list) ;; <compat-tests:take-while>
"Return the longest prefix of LIST whose elements satisfy PRED."
(let ((r nil))
(while (and list (funcall pred (car list)))
(push (car list) r)
(setq list (cdr list)))
(nreverse r)))
(compat-defun drop-while (pred list) ;; <compat-tests:drop-while>
"Skip initial elements of LIST satisfying PRED and return the rest."
(while (and list (funcall pred (car list)))
(setq list (cdr list)))
list)
(compat-defun all (pred list) ;; <compat-tests:all>
"Non-nil if PRED is true for all elements in LIST."
(not (drop-while pred list)))
(compat-defun member-if (pred list) ;; <compat-tests:member-if>
"Non-nil if PRED is true for at least one element in LIST.
Returns the LIST suffix starting at the first element that satisfies PRED,
or nil if none does."
(drop-while (lambda (x) (not (funcall pred x))) list))
(compat-defalias any member-if) ;; <compat-tests:member-if>
(compat-defun hash-table-contains-p (key table) ;; <compat-tests:hash-table-contains-p>
"Return non-nil if TABLE has an element with KEY."
(declare (side-effect-free t))
(let ((missing '#:missing))
(not (eq (gethash key table missing) missing))))
(compat-defmacro static-when (condition &rest body) ;; <compat-tests:static-when>
"A conditional compilation macro.
Evaluate CONDITION at macro-expansion time. If it is non-nil,
expand the macro to evaluate all BODY forms sequentially and return
the value of the last one, or nil if there are none."
(declare (indent 1) (debug t))
(if body
(if (eval condition lexical-binding)
(cons 'progn body)
nil)
(macroexp-warn-and-return (format-message "`static-when' with empty body")
(list 'progn nil nil) '(empty-body static-when) t)))
(compat-defmacro static-unless (condition &rest body) ;; <compat-tests:static-unless>
"A conditional compilation macro.
Evaluate CONDITION at macro-expansion time. If it is nil,
expand the macro to evaluate all BODY forms sequentially and return
the value of the last one, or nil if there are none."
(declare (indent 1) (debug t))
(if body
(if (eval condition lexical-binding)
nil
(cons 'progn body))
(macroexp-warn-and-return (format-message "`static-unless' with empty body")
(list 'progn nil nil) '(empty-body static-unless) t)))
(compat-defun oddp (integer) ;; <compat-tests:oddp>
"Return t if INTEGER is odd."
(not (eq (% integer 2) 0)))
(compat-defun evenp (integer) ;; <compat-tests:evenp>
"Return t if INTEGER is even."
(eq (% integer 2) 0))
(compat-defun plusp (number) ;; <compat-tests:plusp>
"Return t if NUMBER is positive."
(> number 0))
(compat-defun minusp (number) ;; <compat-tests:minusp>
"Return t if NUMBER is negative."
(< number 0))
(compat-defmacro incf (place &optional delta) ;; <compat-tests:incf>
"Increment PLACE by DELTA (default to 1).
The DELTA is first added to PLACE, and then stored in PLACE.
Return the incremented value of PLACE.
See also `decf'."
(gv-letplace (getter setter) place
(funcall setter `(+ ,getter ,(or delta 1)))))
(compat-defmacro decf (place &optional delta) ;; <compat-tests:decf>
"Decrement PLACE by DELTA (default to 1).
The DELTA is first subtracted from PLACE, and then stored in PLACE.
Return the decremented value of PLACE.
See also `incf'."
(gv-letplace (getter setter) place
(funcall setter `(- ,getter ,(or delta 1)))))
;;;; Defined in color.el
(compat-defun color-blend (a b &optional alpha) ;; <compat-tests:color-blend>
"Blend the two colors A and B in linear space with ALPHA.
A and B should be lists (RED GREEN BLUE), where each element is
between 0.0 and 1.0, inclusive. ALPHA controls the influence A
has on the result and should be between 0.0 and 1.0, inclusive.
For instance:
(color-blend \\='(1 0.5 1) \\='(0 0 0) 0.75)
=> (0.75 0.375 0.75)"
(setq alpha (or alpha 0.5))
(let (blend)
(dotimes (i 3)
(push (+ (* (nth i a) alpha) (* (nth i b) (- 1 alpha))) blend))
(nreverse blend)))
;;;; Defined in time-date.el
(compat-defvar seconds-to-string ;; <compat-tests:seconds-to-string>
(list (list 1 "ms" 0.001)
(list 100 "s" 1)
(list (* 60 100) "m" 60.0)
(list (* 3600 30) "h" 3600.0)
(list (* 3600 24 400) "d" (* 3600.0 24.0))
(list nil "y" (* 365.25 24 3600)))
"Formatting used by the function `seconds-to-string'.")
(compat-defvar seconds-to-string-readable ;; <compat-tests:seconds-to-string>
`(("Y" "year" "years" ,(round (* 60 60 24 365.2425)))
("M" "month" "months" ,(round (* 60 60 24 30.436875)))
("w" "week" "weeks" ,(* 60 60 24 7))
("d" "day" "days" ,(* 60 60 24))
("h" "hour" "hours" ,(* 60 60))
("m" "minute" "minutes" 60)
("s" "second" "seconds" 1))
"Formatting used by the function `seconds-to-string' with READABLE set.
The format is an alist, with string keys ABBREV-UNIT, and elements like:
(ABBREV-UNIT UNIT UNIT-PLURAL SECS)
where UNIT is a unit of time, ABBREV-UNIT is the abbreviated form of
UNIT, UNIT-PLURAL is the plural form of UNIT, and SECS is the number of
seconds per UNIT.")
(compat-defun seconds-to-string (delay &optional readable abbrev precision) ;; <compat-tests:seconds-to-string>
"Handle optional arguments READABLE, ABBREV and PRECISION."
:extended t
(cond
((< delay 0)
(concat "-" (seconds-to-string (- delay) readable precision)))
(readable
(let* ((stsa seconds-to-string-readable)
(expanded (eq readable 'expanded))
digits
(round-to (cond
((wholenump precision)
(setq digits precision)
(expt 10 (- precision)))
((and (floatp precision) (< precision 1.))
(setq digits (- (floor (log precision 10))))
precision)
(t (setq digits 0) 1)))
(dformat (if (> digits 0) (format "%%0.%df" digits)))
(padding (if abbrev "" " "))
here cnt cnt-pre here-pre cnt-val isfloatp)
(if (= (round delay round-to) 0)
(format "0%s" (if abbrev "s" " seconds"))
(while (and (setq here (pop stsa)) stsa
(< (/ delay (nth 3 here)) 1)))
(or (and
expanded stsa ; smaller unit remains
(progn
(setq
here-pre here here (car stsa)
cnt-pre (floor (/ (float delay) (nth 3 here-pre)))
cnt (round
(/ (- (float delay) (* cnt-pre (nth 3 here-pre)))
(nth 3 here))
round-to))
(if (> cnt 0) t (setq cnt cnt-pre here here-pre here-pre nil))))
(setq cnt (round (/ (float delay) (nth 3 here)) round-to)))
(setq cnt-val (* cnt round-to)
isfloatp (and (> digits 0)
(> (- cnt-val (floor cnt-val)) 0.)))
(cl-labels
((unit (val here &optional plural)
(cond (abbrev (car here))
((and (not plural) (<= (floor val) 1)) (nth 1 here))
(t (nth 2 here)))))
(concat
(when here-pre
(concat (number-to-string cnt-pre) padding
(unit cnt-pre here-pre) " "))
(if isfloatp (format dformat cnt-val)
(number-to-string (floor cnt-val)))
padding
(unit cnt-val here isfloatp)))))) ; float formats are always plural
((= 0 delay) "0s")
(t (let ((sts seconds-to-string) here)
(while (and (car (setq here (pop sts)))
(<= (car here) delay)))
(concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here))))))
;;;; Defined in minibuffer.el
(compat-defun completion-list-candidate-at-point (&optional pt) ;; <compat-tests:completion-list-candidate-at-point>
"Candidate string and bounds at PT in completions buffer.
The return value has the format (STR BEG END).
The optional argument PT defaults to (point)."
(let ((pt (or pt (point))) beg end)
(cond
((and (/= pt (point-max)) (get-text-property pt 'mouse-face))
(setq end pt beg (1+ pt)))
((and (/= pt (point-min)) (get-text-property (1- pt) 'mouse-face))
(setq end (1- pt) beg pt)))
(when (and beg end)
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face) (point-max)))
(list (or (get-text-property beg 'completion--string)
(buffer-substring beg end))
beg end))))
(compat-defun completion-table-with-metadata (table metadata) ;; <compat-tests:completion-table-with-metadata>
"Return new completion TABLE with METADATA.
METADATA should be an alist of completion metadata. See
`completion-metadata' for a list of supported metadata."
(lambda (string pred action)
(if (eq action 'metadata)
`(metadata . ,metadata)
(complete-with-action action table string pred))))
;;;; Defined in subr-x.el
(compat-defun add-remove--display-text-property (start end spec value &optional object remove) ;; <compat-tests:add-display-text-property>
"Helper function for `add-display-text-property' and `remove-display-text-property'."
(let ((sub-start start)
(sub-end 0)
(limit (if (stringp object)
(min (length object) end)
(min end (point-max))))
disp)
(while (< sub-end end)
(setq sub-end (next-single-property-change sub-start 'display object
limit))
(if (not (setq disp (get-text-property sub-start 'display object)))
(unless remove
(put-text-property sub-start sub-end 'display (list spec value)
object))
(let ((changed nil)
type)
(setq disp
(cond
((vectorp disp)
(setq type 'vector)
(seq-into disp 'list))
((or (not (consp (car-safe disp)))
(eq (caar disp) 'margin))
(setq type 'scalar)
(list disp))
(t
(setq type 'list)
disp)))
(when-let* ((old (assoc spec disp)))
(setq disp (if (eq type 'list)
(remove old disp)
(delete old disp))
changed t))
(unless remove
(setq disp (cons (list spec value) disp)
changed t))
(when changed
(if (not disp)
(remove-text-properties sub-start sub-end '(display nil) object)
(when (eq type 'vector)
(setq disp (seq-into disp 'vector)))
(put-text-property sub-start sub-end 'display disp object)))))
(setq sub-start sub-end))))
(compat-defun remove-display-text-property (start end spec &optional object) ;; <compat-tests:remove-display-text-property>
"Remove the display specification SPEC from the text from START to END.
SPEC is the car of the display specification to remove, e.g. `height'.
If any text in the region has other display specifications, those specs
are retained.
OBJECT is either a string or a buffer to remove the specification from.
If omitted, OBJECT defaults to the current buffer."
(add-remove--display-text-property start end spec nil object 'remove))
(compat-defvar work-buffer-limit 10 ;; <compat-tests:with-work-buffer>
"Maximum number of reusable work buffers.
When this limit is exceeded, newly allocated work buffers are
automatically killed, which means that in a such case
`with-work-buffer' becomes equivalent to `with-temp-buffer'.")
;; On Emacs 29 and newer `kill-all-local-variables' has a KILL-PERMANENT argument.
(static-if (< emacs-major-version 29) nil
(compat-defvar work-buffer--list nil ;; <compat-tests:with-work-buffer>
"List of work buffers.")
(compat-defun work-buffer--get () ;; <compat-tests:with-work-buffer>
"Get a work buffer."
(let ((buffer (pop work-buffer--list)))
(if (buffer-live-p buffer)
buffer
(generate-new-buffer " *work*" t))))
(compat-defun work-buffer--release (buffer) ;; <compat-tests:with-work-buffer>
"Release work BUFFER."
(if (buffer-live-p buffer)
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(delete-all-overlays))
(let (change-major-mode-hook)
(setq buffer-read-only nil)
(kill-all-local-variables t))
(push buffer work-buffer--list)))
(when (> (length work-buffer--list) work-buffer-limit)
(mapc #'kill-buffer (nthcdr work-buffer-limit work-buffer--list))
(setq work-buffer--list (ntake work-buffer-limit work-buffer--list)))))
(compat-defmacro with-work-buffer (&rest body) ;; <compat-tests:with-work-buffer>
"Create a work buffer, and evaluate BODY there like `progn'.
Like `with-temp-buffer', but reuse an already created temporary buffer
when possible, instead of creating a new one on each call. Avoid
retaining state referring to a work buffer, and kill any indirect
buffers you create that use a work buffer as a base."
(declare (indent 0) (debug t))
(static-if (< emacs-major-version 29)
`(with-temp-buffer ,@body)
(let ((work-buffer (make-symbol "work-buffer")))
`(let ((,work-buffer (work-buffer--get)))
(with-current-buffer ,work-buffer
(unwind-protect
(progn ,@body)
(work-buffer--release ,work-buffer)))))))
;;;; Defined in button.el
(compat-defun unbuttonize-region (start end) ;; <compat-tests:buttonize-region>
"Remove all the buttons between START and END.
This removes both text-property and overlay based buttons."
(dolist (o (overlays-in start end))
(when (overlay-get o 'button)
(delete-overlay o)))
(with-silent-modifications
(remove-text-properties start end (button--properties nil nil nil))
(add-face-text-property start end 'button nil)))
(provide 'compat-31)
;;; compat-31.el ends here
lisp/compat/compat-macs.el
+2 -2
View File
@@ -1,6 +1,6 @@
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -103,7 +103,7 @@ REST are attributes and the function BODY."
(lambda (extended obsolete body)
(when (stringp extended)
(compat-macs--assert
(and (version< extended compat-macs--version) (version< "24.4" extended))
(and (version< extended compat-macs--version) (version< "25.1" extended))
"Invalid :extended version %s for %s %s" extended type name)
(setq extended (version<= extended emacs-version)))
(compat-macs--strict (eq extended (fboundp name))
lisp/compat/compat-pkg.el
+1 -1
View File
@@ -1,2 +1,2 @@
;; Generated package description from compat.el -*- no-byte-compile: t -*-
(define-package "compat" "30.1.0.1" "Emacs Lisp Compatibility Library" '((emacs "24.4") (seq "2.23")) :commit "cccd41f549fa88031a32deb26253b462021d7e12" :authors '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp" "maint") :url "https://github.com/emacs-compat/compat")
(define-package "compat" "31.0.0.1" "Emacs Lisp Compatibility Library" '((emacs "25.1")) :commit "b5b48183689b536f72b1214106afeabc465da9d4" :authors '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :keywords '("lisp" "maint") :url "https://github.com/emacs-compat/compat")
lisp/compat/compat.el
+7 -7
View File
@@ -1,12 +1,12 @@
;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; Version: 30.1.0.1
;; Maintainer: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de>
;; Version: 31.0.0.1
;; URL: https://github.com/emacs-compat/compat
;; Package-Requires: ((emacs "24.4") (seq "2.23"))
;; Package-Requires: ((emacs "25.1"))
;; Keywords: lisp, maint
;; This program is free software; you can redistribute it and/or modify
@@ -50,9 +50,9 @@
;; time and runtime, but only if needed.
(eval-when-compile
(defmacro compat--maybe-require ()
(when (version< emacs-version "30.1")
(require 'compat-30)
'(require 'compat-30))))
(when (< emacs-major-version 31)
(require 'compat-31)
'(require 'compat-31))))
(compat--maybe-require)
;;;; Macros for extended compatibility function calls
lisp/compat/compat.info
+360 -338
View File
File diff suppressed because it is too large Load Diff
lisp/cond-let/cond-let-pkg.el
+6 -4
View File
@@ -1,8 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "cond-let" "20260201.1500"
(define-package "cond-let" "20260601.1457"
"Additional and improved binding conditionals."
'((emacs "28.1"))
:url "https://github.com/tarsius/cond-let"
:commit "8bf87d45e169ebc091103b2aae325aece3aa804d"
:revdesc "8bf87d45e169"
:keywords '("extensions"))
:commit "21b9e9835756ff5cd1acb971cf9eb56fff671c8b"
:revdesc "21b9e9835756"
:keywords '("extensions")
:authors '(("Jonas Bernoulli" . "emacs.cond-let@jonas.bernoulli.dev"))
:maintainers '(("Jonas Bernoulli" . "emacs.cond-let@jonas.bernoulli.dev")))
lisp/cond-let/cond-let.el
+70 -39
View File
@@ -5,12 +5,12 @@
;; May contain traces of Emacs, which is
;; Copyright (C) 1985-2025 Free Software Foundation, Inc.
;; Authors: Jonas Bernoulli <emacs.cond-let@jonas.bernoulli.dev>
;; Author: Jonas Bernoulli <emacs.cond-let@jonas.bernoulli.dev>
;; Homepage: https://github.com/tarsius/cond-let
;; Keywords: extensions
;; Package-Version: 20260201.1500
;; Package-Revision: 8bf87d45e169
;; Package-Version: 20260601.1457
;; Package-Revision: 21b9e9835756
;; Package-Requires: ((emacs "28.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -30,16 +30,12 @@
;;; Commentary:
;; This is a BETA release!
;; Breaking changes are unlikely but still possible!
;; See https://github.com/tarsius/cond-let/wiki.
;; Emacs provides the binding conditionals `if-let', `if-let*',
;; `when-let', `when-let*', `and-let*' and `while-let'.
;; This package implements the missing `and-let' and `while-let*',
;; This package implements the missing `and-let' and `while-let*';
;; and the original `cond-let', `cond-let*', `when$', `and$' and
;; `and>'.
;; `thread$'.
;; This package additionally provides more consistent and improved
;; implementations of the binding conditionals already provided by
@@ -59,13 +55,17 @@
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when$" . "cond-let--when$")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let"))
;; ("and$" . "cond-let--and$")
;; ("thread$" . "cond-let--thread$")
;; ("when$" . "cond-let--when$")
;; ("and-let*" . "cond-let--and-let*")
;; ("and-let" . "cond-let--and-let")
;; ("if-let*" . "cond-let--if-let*")
;; ("if-let" . "cond-let--if-let")
;; ("when-let*" . "cond-let--when-let*")
;; ("when-let" . "cond-let--when-let")
;; ("while-let*" . "cond-let--while-let*")
;; ("while-let" . "cond-let--while-let"))
;; End:
;; You can think of these file-local settings as import statements of
@@ -76,8 +76,8 @@
;; Due to limitations of the shorthand implementation this has to be
;; done for each individual library. "dir-locals.el" cannot be used.
;; If you use `when$', `and$' and `and>', you might want to add this
;; to your configuration:
;; If you use `when$', `and$' and `thread$', you might want to add
;; this to your configuration:
;; (with-eval-after-load 'cond-let
;; (font-lock-add-keywords 'emacs-lisp-mode
@@ -198,7 +198,8 @@ remaining clauses and binding vectors. Evaluate all VALUEFORMs before
binding their respective SYMBOLs. Unlike for the previous form, bind
all SYMBOLs, even if a VALUEFORM yields nil. Always proceed to the
next clause."
(declare (indent 0) (debug cond-let*))
(declare (indent 0)
(debug cond-let*))
(let ((tag (gensym ":cond-let")))
`(catch ',tag
,@(cond-let--prepare-clauses tag nil clauses))))
@@ -289,7 +290,8 @@ nil, and evaluate neither the remaining VALUEFORMs nor BODYFORM. If all
VALUEFORMs yield non-nil, evaluate BODYFORM with the bindings in effect,
and return its value; or if there is no BODYFORM, the value of the last
VALUEFORM."
(declare (indent 1) (debug cond-let--and-let*))
(declare (indent 1)
(debug cond-let--and-let*))
(pcase-let ((`(,anon ,set ,bind ,lastvar)
(cond-let--prepare-varforms varlist)))
(cond (anon
@@ -303,19 +305,10 @@ VALUEFORM."
`(and ,lastvar ,bodyform)
lastvar))))))
(defmacro cond-let--and$ (varform bodyform)
"Bind variable `$' to value of VARFORM and conditionally evaluate BODYFORM.
;;; Thread
If VARFORM yields a non-nil value, bind the symbol `$' to that value,
evaluate BODYFORM with that binding in effect, and return the value of
BODYFORM. If VARFORM yields nil, do not evaluate BODYFORM, and return
nil."
(declare (debug (form form)))
`(let (($ ,varform))
(and $ ,bodyform)))
(defmacro cond-let--and> (form form2 &rest forms)
"Bind variables according to each VARFORM until one of them yields nil.
(defmacro cond-let--and$ (form form2 &rest forms)
"Bind variables according to each FORM until one of them yields nil.
Evaluate the first FORM and if that yields a non-nil value, bind the
symbol `$' to that value, and evaluate the next FORM with that binding
@@ -324,7 +317,8 @@ nil, then return nil without evaluate the remaining FORMs. If all
FORMs yield non-nil, return the value of the last FORM.
\(fn FORM FORM...)"
(declare (debug (form form body)))
(declare (indent 0)
(debug t))
`(,(if forms 'let* 'let)
(($ ,form)
,@(and forms
@@ -335,6 +329,25 @@ FORMs yield non-nil, return the value of the last FORM.
,(or (car (last forms))
form2))))
(defmacro cond-let--thread$ (form form2 &rest forms)
"Bind variable `$' to value of nth FORM before evaluating nth+1 FORM.
Evaluate the first FORM and bind the symbol `$' to its value.
Then evaluate the next FORM with that binding in effect. Repeat this
process with subsequent FORMs, and return the value of the last FORM.
\(fn FORM FORM...)"
(declare (indent 0)
(debug t))
`(,(if forms 'let* 'let)
(($ ,form)
,@(and forms
(mapcar (lambda (form)
`($ ,form))
(cons form2 (butlast forms)))))
,(or (car (last forms))
form2)))
;;; If
(defmacro cond-let--if-let* (varlist then &rest else)
@@ -378,7 +391,8 @@ value of the last form; or if there are no ELSE forms return nil. The
bindings from VARLIST do _not_ extend to the ELSE forms.
\(fn VARLIST THEN [ELSE...])"
(declare (indent 2) (debug cond-let--if-let*))
(declare (indent 2)
(debug cond-let--if-let*))
(pcase-let* ((`(,anon ,set ,bind ,_)
(cond-let--prepare-varforms varlist t))
(set (if (length= set 1) (car set) (cons 'and set))))
@@ -432,7 +446,8 @@ BODY must be one or more expressions. If VARLIST is empty, do nothing
and return nil.
\(fn VARLIST BODY...)"
(declare (indent 1) (debug cond-let--when-let*))
(declare (indent 1)
(debug cond-let--when-let*))
(pcase-let ((`(,anon ,set ,bind ,lastvar)
(cond-let--prepare-varforms varlist)))
(cond (anon
@@ -454,8 +469,9 @@ last form. If VARFORM yields nil, do not evaluate BODY, and return nil.
BODY must be one or more expressions. If VARLIST is empty, do nothing
and return nil.
\(fn VARLIST BODY...)"
(declare (indent 1) (debug (form form)))
\(fn VARFORM BODY...)"
(declare (indent 1)
(debug t))
`(let (($ ,varform))
(when $
,bodyform ,@body)))
@@ -478,7 +494,8 @@ nor the BODY forms, and instead return, always yielding nil.
BODY can be zero or more expressions.
\(fn VARLIST [BODY...])"
(declare (indent 1) (debug cond-let--if-let*))
(declare (indent 1)
(debug ((&rest (symbolp form)) body)))
(pcase-let ((`(,varlist ,lastvar)
(cond-let--prepare-varlist varlist))
(tag (gensym ":while-let*")))
@@ -505,7 +522,8 @@ nor the BODY forms, and instead return, always yielding nil.
BODY can be one or more expressions.
\(fn VARLIST BODY...)"
(declare (indent 1) (debug cond-let--if-let*))
(declare (indent 1)
(debug ((&rest (symbolp form)) form body)))
(pcase-let ((`(,anon ,set ,bind ,lastvar)
(cond-let--prepare-varforms varlist))
(tag (gensym ":while-let")))
@@ -533,5 +551,18 @@ BODY can be one or more expressions.
To add these keywords, add this to your configuration:
\(font-lock-add-keywords \\='emacs-lisp-mode cond-let-font-lock-keywords t)")
;;; Compatibility
(defalias 'cond-let--and> #'cond-let--and$
"Instead of this alias, use `cond-let--and$' via `and$' shorthand.
This alias will likely be declared obsolete in 2027. If you would like
to continue to use it, please get in contact before then. This alias
might eventually be removed altogether; again subject to user feedback.
If you do not care about the symbol `cond-let--and>', but want to keep
using the respective `and>' shorthand, you can future-proof that now,
by changing the shorthand definition to (\"and>\" . \"cond-let--and$\").")
(provide 'cond-let)
;;; cond-let.el ends here
lisp/diff-hl/diff-hl-amend.el
+2 -2
View File
@@ -44,7 +44,7 @@ Currently only supports Git, Mercurial and Bazaar."
(diff-hl-update)))
(defun diff-hl-amend-setup ()
(let ((backend (vc-backend buffer-file-name)))
(let ((backend (vc-backend (diff-hl--buffer-file-name))))
(when backend
(setq-local diff-hl-reference-revision
(cl-case backend
@@ -62,7 +62,7 @@ Currently only supports Git, Mercurial and Bazaar."
(defun turn-on-diff-hl-amend-mode ()
"Turn on `diff-hl-amend-mode' in a buffer if appropriate."
(and buffer-file-name (diff-hl-amend-mode 1)))
(and (diff-hl--buffer-file-name) (diff-hl-amend-mode 1)))
(provide 'diff-hl-amend)
lisp/diff-hl/diff-hl-autoloads.el
+1 -1
View File
@@ -189,7 +189,7 @@ disabled.
(fn &optional ARG)" t)
(autoload 'diff-hl-dired-mode-unless-remote "diff-hl-dired")
(register-definition-prefixes "diff-hl-dired" '("diff-hl-dired-"))
(register-definition-prefixes "diff-hl-dired" '("diff-hl-dir"))
;;; Generated autoloads from diff-hl-flydiff.el
lisp/diff-hl/diff-hl-dired.el
+84 -21
View File
@@ -1,6 +1,6 @@
;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding: t -*-
;; Copyright (C) 2012-2017, 2023 Free Software Foundation, Inc.
;; Copyright (C) 2012-2017, 2023-2026 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -86,7 +86,7 @@ status indicators."
(progn
(diff-hl-maybe-define-bitmaps)
(set (make-local-variable 'diff-hl-dired-process-buffer) nil)
(add-hook 'dired-after-readin-hook 'diff-hl-dired-update nil t))
(add-hook 'dired-after-readin-hook 'diff-hl-dired-update 10 t))
(remove-hook 'dired-after-readin-hook 'diff-hl-dired-update t)
(diff-hl-dired-clear)))
@@ -97,7 +97,6 @@ status indicators."
(buffer (current-buffer))
dirs-alist files-alist)
(when (and backend (not (memq backend diff-hl-dired-ignored-backends)))
(diff-hl-dired-clear)
(if (buffer-live-p diff-hl-dired-process-buffer)
(let ((proc (get-buffer-process diff-hl-dired-process-buffer)))
(when proc (kill-process proc)))
@@ -109,30 +108,29 @@ status indicators."
(diff-hl-dired-status-files
backend def-dir
(when diff-hl-dired-extra-indicators
(cl-loop for file in (directory-files def-dir)
unless (member file '("." ".." ".hg"))
collect file))
(with-current-buffer buffer
(diff-hl-dired-nondirectory-files)))
(lambda (entries &optional more-to-come)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(dolist (entry entries)
(cl-destructuring-bind (file state &rest r) entry
;; Work around http://debbugs.gnu.org/18605
(setq file (replace-regexp-in-string "\\` " "" file))
(let ((type (plist-get
'( edited change added insert removed delete
unregistered unknown ignored ignored)
state)))
(if (string-match "\\`\\([^/]+\\)/" file)
(let* ((dir (match-string 1 file))
(value (cdr (assoc dir dirs-alist))))
(unless (eq state 'up-to-date)
(let ((type (plist-get '( edited change added insert removed delete
unregistered unknown ignored ignored)
state))
(dirs (cl-loop with pos = 0
while (string-match "/" file pos)
do (setq pos (match-end 0))
collect (substring file 0 (1- pos)))))
(dolist (dir dirs)
(let ((value (cdr (assoc dir dirs-alist))))
(unless (eq value type)
(cond
((eq state 'up-to-date))
((null value)
(push (cons dir type) dirs-alist))
((not (eq type 'ignored))
(setcdr (assoc dir dirs-alist) 'change)))))
(setcdr (assoc dir dirs-alist) 'change))))))
(push (cons file type) files-alist)))))
(unless more-to-come
(diff-hl-dired-highlight-items
@@ -142,19 +140,84 @@ status indicators."
)))))
(defun diff-hl-dired-status-files (backend dir files update-function)
"Using version control BACKEND, return list of (FILE STATE EXTRA) entries
for DIR containing FILES. Call UPDATE-FUNCTION as entries are added."
(vc-call-backend backend 'dir-status-files dir files update-function))
"Using VC BACKEND, fetch list of (FILE STATE EXTRA) entries for DIR.
Call UPDATE-FUNCTION as entries are added."
(vc-call-backend
backend 'dir-status-files
dir nil
(lambda (entries &optional more-to-come)
(if (or more-to-come
(not diff-hl-dired-extra-indicators))
(funcall update-function entries more-to-come)
(diff-hl-dir-status-ignored-files
backend
dir
files
(lambda (ignored-entries &optional more-to-come)
(funcall update-function ignored-entries t)
(unless more-to-come
(funcall update-function entries nil))))
))))
(defun diff-hl-dired-nondirectory-files ()
(cl-mapcan
(lambda (entry)
(let* ((dir (file-relative-name (car entry)))
(all (file-name-all-completions "" dir))
res)
(dolist (file all)
(unless (directory-name-p file)
(push
(if (equal dir "./")
file
(concat dir file))
res)))
res))
dired-subdir-alist))
(declare-function vc-git-dir-status-goto-stage "vc-git")
(declare-function make-vc-git-dir-status-state "vc-git")
(declare-function vc-hg-command "vc-hg")
(declare-function vc-hg--program-version "vc-hg")
(declare-function vc-hg-after-dir-status "vc-hg")
(defun diff-hl-dir-status-ignored-files (backend dir files update-function)
(cond
((eq backend 'Git)
(vc-git-dir-status-goto-stage
(make-vc-git-dir-status-state :stage 'ls-files-ignored
:files files
:update-function update-function)))
((eq backend 'Hg)
(let ((default-directory dir))
(erase-buffer)
(apply #'vc-hg-command (current-buffer) 'async files
"status" "-i"
(if (version<= "4.2" (vc-hg--program-version))
'("--config" "commands.status.relative=1")
'("re:" "-I" "."))))
(static-if (fboundp 'vc-run-delayed-success)
(vc-run-delayed-success 0
(vc-hg-after-dir-status update-function))
(vc-run-delayed
(vc-hg-after-dir-status update-function))))
;; No specialized solution for "list only ignored state", list all.
;; If the backend doesn't use several process calls (like Git), the
;; difference should be trivial.
(t
(vc-call-backend backend 'dir-status-files dir files
update-function))))
(defun diff-hl-dired-highlight-items (alist)
"Highlight ALIST containing (FILE . TYPE) elements."
(diff-hl-dired-clear) ;; clear overlays right before drawing to avoid flicker
(dolist (pair alist)
(let ((file (car pair))
(type (cdr pair)))
(save-excursion
(goto-char (point-min))
(when (and type (dired-goto-file-1
file (expand-file-name file) nil))
(file-name-nondirectory file) (expand-file-name file) nil))
(let* ((diff-hl-fringe-bmp-function diff-hl-dired-fringe-bmp-function)
(diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
(o (diff-hl-add-highlighting type 'single)))
lisp/diff-hl/diff-hl-flydiff.el
+9 -7
View File
@@ -1,4 +1,4 @@
;; Copyright (C) 2015-2025 Free Software Foundation, Inc. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2026 Free Software Foundation, Inc. -*- lexical-binding: t -*-
;; Author: Jonathan Hayase <PythonNut@gmail.com>
;; URL: https://github.com/dgutov/diff-hl
@@ -42,7 +42,6 @@
(defun diff-hl-flydiff-changes-buffer (file backend &optional new-rev buffer)
(setq buffer (or buffer " *diff-hl-diff*"))
(setq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
(if new-rev
(diff-hl-with-diff-switches
(diff-hl-diff-against-reference file backend buffer new-rev))
@@ -52,13 +51,16 @@
(unless (or
(not diff-hl-mode)
(eq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
(not buffer-file-name)
(file-remote-p default-directory)
(not (file-exists-p buffer-file-name)))
(let ((file (diff-hl--buffer-file-name)))
(or (not file)
(file-remote-p default-directory)
(not (file-exists-p file)))))
(setq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
(diff-hl-update)))
(defun diff-hl-flydiff/modified-p (_state)
(buffer-modified-p))
(defun diff-hl-flydiff/modified-p (state)
(unless (memq state '(added missing nil))
(buffer-modified-p)))
;;;###autoload
(define-minor-mode diff-hl-flydiff-mode
lisp/diff-hl/diff-hl-margin.el
+5 -3
View File
@@ -132,13 +132,15 @@ You probably shouldn't use this function directly."
#'diff-hl-highlight-on-margin)
(setq-local diff-hl-highlight-reference-function
#'diff-hl-highlight-on-margin-flat)
(setq-local diff-hl-margin-old-width (symbol-value width-var))
(set width-var 1))
(when (zerop (symbol-value width-var))
(setq-local diff-hl-margin-old-width (symbol-value width-var))
(set width-var 1)))
(when diff-hl-margin-old-highlight-function
(setq diff-hl-highlight-function diff-hl-margin-old-highlight-function
diff-hl-highlight-reference-function diff-hl-margin-old-highlight-ref-function
diff-hl-margin-old-highlight-function nil))
(set width-var diff-hl-margin-old-width)
(when diff-hl-margin-old-width
(set width-var diff-hl-margin-old-width))
(kill-local-variable 'diff-hl-margin-old-width)))
(dolist (win (get-buffer-window-list))
(set-window-buffer win (current-buffer))))
lisp/diff-hl/diff-hl-pkg.el
+4 -4
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "diff-hl" "20260328.1925"
(define-package "diff-hl" "20260627.208"
"Highlight uncommitted changes using VC."
'((cl-lib "0.2")
(emacs "26.1"))
(emacs "27.1"))
:url "https://github.com/dgutov/diff-hl"
:commit "b965e19e6e7f9933199e421849a49229207c1c9f"
:revdesc "b965e19e6e7f"
:commit "2d7d0714d9637f54af672987c65b6973b31e56a2"
:revdesc "2d7d0714d963"
:keywords '("vc" "diff")
:authors '(("Dmitry Gutov" . "dmitry@gutov.dev"))
:maintainers '(("Dmitry Gutov" . "dmitry@gutov.dev")))
lisp/diff-hl/diff-hl-show-hunk-inline.el
+25 -8
View File
@@ -74,6 +74,13 @@ the hunk consist only on added lines, then
`diff-hl-show-hunk--no-lines-removed-message' it is shown."
:type 'boolean)
(defcustom diff-hl-show-hunk-inline-scroll-indicators '(" ⬆ " . " ⬇ ")
"Strings used to indicate hidden inline popup content.
The car is used for hidden content above the popup; the cdr is used for
hidden content below it. Each string includes any surrounding padding."
:type '(cons (string :tag "Above")
(string :tag "Below")))
(defun diff-hl-show-hunk-inline--splice (list offset length)
"Compute a sublist of LIST starting at OFFSET, of LENGTH."
(butlast
@@ -105,27 +112,37 @@ Compute it from LINES starting at INDEX with a WINDOW-SIZE."
(index (min index (- len window-size))))
(diff-hl-show-hunk-inline--splice lines index window-size)))
(defun diff-hl-show-hunk-inline--underline-face ()
"Return the face used for inline popup underlines."
`(:underline ,(if (>= emacs-major-version 29) '(:position t) t)))
(defun diff-hl-show-hunk-inline--compute-header (width &optional header)
"Compute the header of the popup.
Compute it from some WIDTH, and some optional HEADER text."
(let* ((scroll-indicator (if (eq diff-hl-show-hunk-inline--current-index 0) " " " ⬆ "))
(let* ((above-indicator (car diff-hl-show-hunk-inline-scroll-indicators))
(scroll-indicator
(if (eq diff-hl-show-hunk-inline--current-index 0)
(make-string (length above-indicator) ?\s)
above-indicator))
(header (or header ""))
(new-width (- width (length header) (length scroll-indicator)))
(header (if (< new-width 0) "" header))
(new-width (- width (length header) (length scroll-indicator)))
(line (propertize (concat (diff-hl-show-hunk-inline--separator new-width)
header scroll-indicator )
'face '(:underline t))))
'face (diff-hl-show-hunk-inline--underline-face))))
(concat line "\n") ))
(defun diff-hl-show-hunk-inline--compute-footer (width &optional footer)
"Compute the header of the popup.
Compute it from some WIDTH, and some optional FOOTER text."
(let* ((scroll-indicator (if (>= diff-hl-show-hunk-inline--current-index
(- (length diff-hl-show-hunk-inline--current-lines)
diff-hl-show-hunk-inline--height))
" "
" ⬇ "))
(let* ((below-indicator (cdr diff-hl-show-hunk-inline-scroll-indicators))
(scroll-indicator
(if (>= diff-hl-show-hunk-inline--current-index
(- (length diff-hl-show-hunk-inline--current-lines)
diff-hl-show-hunk-inline--height))
(make-string (length below-indicator) ?\s)
below-indicator))
(footer (or footer ""))
(new-width (- width (length footer) (length scroll-indicator)))
(footer (if (< new-width 0) "" footer))
@@ -133,7 +150,7 @@ Compute it from some WIDTH, and some optional FOOTER text."
(blank-line (if (display-graphic-p)
""
(concat "\n" (propertize (diff-hl-show-hunk-inline--separator width)
'face '(:underline t)))))
'face (diff-hl-show-hunk-inline--underline-face)))))
(line (propertize (concat (diff-hl-show-hunk-inline--separator new-width)
footer scroll-indicator)
'face '(:overline t))))
lisp/diff-hl/diff-hl-show-hunk.el
+7 -6
View File
@@ -129,15 +129,16 @@ Then put the differences inside a special buffer and set the
point in that buffer to the corresponding line of the original
buffer."
(defvar vc-sentinel-movepoint)
(let* ((buffer (or (buffer-base-buffer) (current-buffer)))
(let* ((buffer (current-buffer))
(diff-hl-update-async nil)
(line (line-number-at-pos))
(dest-buffer diff-hl-show-hunk-diff-buffer-name))
(with-current-buffer buffer
(if (buffer-modified-p)
(diff-hl-diff-buffer-with-reference buffer-file-name dest-buffer)
(diff-hl-changes-buffer buffer-file-name (vc-backend buffer-file-name)
nil dest-buffer))
(let ((file (diff-hl--buffer-file-name)))
(if (buffer-modified-p)
(diff-hl-diff-buffer-with-reference file dest-buffer)
(diff-hl-changes-buffer file (vc-backend file)
nil dest-buffer)))
(switch-to-buffer dest-buffer)
(diff-hl-diff-skip-to line)
(setq vc-sentinel-movepoint (point)))
@@ -303,7 +304,7 @@ end of the OVERLAY, so posframe/inline is placed below the hunk."
The backend is determined by `diff-hl-show-hunk-function'."
(interactive)
(unless (vc-backend buffer-file-name)
(unless (vc-backend (diff-hl--buffer-file-name))
(user-error "The buffer is not under version control"))
(diff-hl-find-current-hunk)
lisp/diff-hl/diff-hl.el
+116 -93
View File
@@ -1,13 +1,13 @@
;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding: t -*-
;; Copyright (C) 2012-2025 Free Software Foundation, Inc.
;; Copyright (C) 2012-2026 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dmitry@gutov.dev>
;; URL: https://github.com/dgutov/diff-hl
;; Keywords: vc, diff
;; Package-Version: 20260328.1925
;; Package-Revision: b965e19e6e7f
;; Package-Requires: ((cl-lib "0.2") (emacs "26.1"))
;; Package-Version: 20260627.208
;; Package-Revision: 2d7d0714d963
;; Package-Requires: ((cl-lib "0.2") (emacs "27.1"))
;; This file is part of GNU Emacs.
@@ -315,6 +315,16 @@ It can be a relative expression as well, such as \"HEAD^\" with Git, or
(lambda (value)
(or (null value) (stringp value))))
(defun diff-hl--target-buffer (&optional buf)
"Return the correct buffer for the situation, preferring the base buffer."
(let ((buf (or buf (current-buffer))))
(or (buffer-base-buffer buf) buf)))
(defun diff-hl--buffer-file-name (&optional buffer)
"Return the file name of the BUFFER or its base buffer.
BUFFER defaults to the current buffer."
(buffer-file-name (diff-hl--target-buffer buffer)))
(defun diff-hl-define-bitmaps ()
(let* ((scale (if (and (boundp 'text-scale-mode-amount)
(numberp text-scale-mode-amount))
@@ -486,7 +496,7 @@ It can be a relative expression as well, such as \"HEAD^\" with Git, or
buffer)
(defun diff-hl-changes ()
(let* ((file buffer-file-name)
(let* ((file (diff-hl--buffer-file-name))
(backend (vc-backend file))
(hide-staged (and (eq backend 'Git) (not diff-hl-show-staged-changes))))
(when backend
@@ -531,7 +541,7 @@ It can be a relative expression as well, such as \"HEAD^\" with Git, or
(or (assoc-default backend diff-hl-head-revision-alist)
;; It's usually cached already (e.g. for mode-line).
;; So this is basically an optimization for rare cases.
(vc-working-revision buffer-file-name backend)))
(vc-working-revision (diff-hl--buffer-file-name) backend)))
(defun diff-hl-adjust-changes (old new)
"Adjust changesets in OLD using changes in NEW.
@@ -596,15 +606,7 @@ contents as they are (or would be) after applying the changes in NEW."
(let (res)
(goto-char (point-min))
(unless (eobp)
;; TODO: When 27.1 is the minimum requirement, we can drop
;; these bindings: that version, in addition to switching over
;; called-interactively-p check, so refinement can't be
;; triggered by code calling the navigation functions, only by
;; direct interactive invocations.
(ignore-errors
(with-no-warnings
(let (diff-auto-refine-mode)
(diff-beginning-of-hunk t))))
(diff-beginning-of-hunk t)
(while (looking-at diff-hunk-header-re-unified)
(let ((line (string-to-number (match-string 3)))
(beg (point)))
@@ -637,7 +639,7 @@ contents as they are (or would be) after applying the changes in NEW."
;; TODO: debounce if a thread is already running.
(let ((buf (current-buffer))
(temp-buffer
(if (< emacs-major-version 28)
(static-if (< emacs-major-version 28)
(generate-new-buffer " *temp*")
(generate-new-buffer " *temp*" t))))
;; Switch buffer temporarily, to "unlock" it for other threads.
@@ -731,27 +733,35 @@ Return a list of line overlays used."
(diff-hl--resolve
reference
(lambda (ref-changes)
(let ((ref-changes (diff-hl-adjust-changes ref-changes changes))
reuse)
(with-current-buffer orig
(diff-hl-remove-overlays)
(let ((diff-hl-highlight-function
diff-hl-highlight-reference-function)
(diff-hl-fringe-face-function
diff-hl-fringe-reference-face-function))
(setq reuse (diff-hl--update-overlays ref-changes nil)))
(diff-hl--update-overlays changes reuse)
(when (not (or changes ref-changes))
(diff-hl--autohide-margin))))))))))
(when (buffer-live-p orig)
(let ((ref-changes (diff-hl-adjust-changes ref-changes changes))
(base (diff-hl--target-buffer orig)))
(dolist (buf (buffer-list))
(when (and (eq (diff-hl--target-buffer buf) base)
(buffer-local-value 'diff-hl-mode buf))
(with-current-buffer buf
(diff-hl-remove-overlays)
(let (reuse)
(when ref-changes
(let ((diff-hl-highlight-function
diff-hl-highlight-reference-function)
(diff-hl-fringe-face-function
diff-hl-fringe-reference-face-function))
(setq reuse (diff-hl--update-overlays ref-changes nil))))
(when changes
(diff-hl--update-overlays changes reuse)))
(unless (or changes ref-changes)
(diff-hl--autohide-margin)))))))))))))
(defun diff-hl--resolve (value-or-buffer cb)
(if (listp value-or-buffer)
(funcall cb value-or-buffer)
(static-if (fboundp 'vc-run-delayed-success)
;; Emacs 31.
(with-current-buffer value-or-buffer
(vc-run-delayed-success 1
(funcall cb (diff-hl-changes-from-buffer (current-buffer)))))
(when (get-buffer value-or-buffer)
(with-current-buffer value-or-buffer
(vc-run-delayed-success 1
(funcall cb (diff-hl-changes-from-buffer (current-buffer))))))
(diff-hl--when-done value-or-buffer
#'diff-hl-changes-from-buffer
cb))))
@@ -844,7 +854,8 @@ Return a list of line overlays used."
(defun diff-hl-diff-goto-hunk-1 (historic rev1)
(defvar vc-sentinel-movepoint)
(vc-buffer-sync)
(with-current-buffer (diff-hl--target-buffer)
(vc-buffer-sync))
(let* ((line (line-number-at-pos))
(buffer (current-buffer))
rev2)
@@ -868,7 +879,7 @@ Return a list of line overlays used."
With double prefix argument (C-u C-u), the diff is made against the
reference revision."
(interactive (list current-prefix-arg))
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(with-current-buffer (current-buffer)
(if (equal historic '(16))
(diff-hl-diff-reference-goto-hunk)
(diff-hl-diff-goto-hunk-1 historic nil))))
@@ -876,7 +887,7 @@ reference revision."
(defun diff-hl-diff-reference-goto-hunk ()
"Run VC diff command against the reference and go to the corresponding line."
(interactive)
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(with-current-buffer (current-buffer)
(diff-hl-diff-goto-hunk-1 nil diff-hl-reference-revision)))
(defun diff-hl-root-diff-reference-goto-hunk ()
@@ -885,7 +896,7 @@ And if the current buffer is visiting a file, and it has changes, the diff
buffer will show the position corresponding to its current line."
(interactive)
(defvar vc-sentinel-movepoint)
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(with-current-buffer (current-buffer)
(let ((backend (vc-deduce-backend))
(default-directory default-directory)
rootdir fileset
@@ -894,11 +905,14 @@ buffer will show the position corresponding to its current line."
(setq rootdir (vc-call-backend backend 'root default-directory)
default-directory rootdir
fileset `(,backend (,rootdir))
relname (if buffer-file-name (file-relative-name buffer-file-name
rootdir)))
relname (let ((file (diff-hl--buffer-file-name)))
(when file
(file-relative-name file rootdir))))
(error "Directory is not version controlled"))
(setq fileset (or fileset (vc-deduce-fileset)))
(vc-buffer-sync-fileset fileset t)
(static-if (< emacs-major-version 28)
(when buffer-file-name (vc-buffer-sync t))
(vc-buffer-sync-fileset fileset t))
(let* ((line (line-number-at-pos)))
(vc-diff-internal
(if (boundp 'vc-allow-async-diff)
@@ -910,7 +924,7 @@ buffer will show the position corresponding to its current line."
(setq vc-sentinel-movepoint (point))))))))
(defun diff-hl-diff-read-revisions (rev1-default)
(let* ((file buffer-file-name)
(let* ((file (diff-hl--buffer-file-name))
(files (list file))
(backend (vc-backend file))
(rev2-default nil))
@@ -1002,7 +1016,8 @@ that file, if it's present."
(defun diff-hl-revert-hunk-1 ()
(save-restriction
(widen)
(vc-buffer-sync)
(with-current-buffer (diff-hl--target-buffer)
(vc-buffer-sync))
(let* ((diff-buffer (get-buffer-create
(generate-new-buffer-name "*diff-hl-revert*")))
(buffer (current-buffer))
@@ -1010,7 +1025,7 @@ that file, if it's present."
(line (save-excursion
(diff-hl-find-current-hunk)
(line-number-at-pos)))
(file buffer-file-name)
(file (diff-hl--buffer-file-name))
(backend (vc-backend file)))
(unwind-protect
(progn
@@ -1029,9 +1044,7 @@ that file, if it's present."
(when (eobp)
(with-current-buffer buffer (diff-hl-remove-overlays))
(user-error "Buffer is up-to-date"))
(with-no-warnings
(let (diff-auto-refine-mode)
(diff-hl-diff-skip-to line)))
(diff-hl-diff-skip-to line)
(setq m-end (diff-hl-split-away-changes 3))
(setq m-beg (point-marker))
(funcall diff-hl-highlight-revert-hunk-function m-end)
@@ -1041,9 +1054,8 @@ that file, if it's present."
(if (>= wbh (- end-line beg-line))
(recenter (/ (+ wbh (- beg-line end-line) 2) 2))
(recenter 1)))
(with-no-warnings
(when diff-auto-refine-mode
(diff-refine-hunk)))
(when (eq diff-refine 'navigation)
(diff-refine-hunk))
(if diff-hl-ask-before-revert-hunk
(unless (yes-or-no-p (format "Revert current hunk in %s? "
file))
@@ -1090,7 +1102,7 @@ its end position."
(defun diff-hl-revert-hunk ()
"Revert the diff hunk with changes at or above the point."
(interactive)
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(with-current-buffer (current-buffer)
(diff-hl-revert-hunk-1)))
(defun diff-hl-hunk-overlay-at (pos)
@@ -1146,7 +1158,7 @@ its end position."
(push-mark (overlay-end hunk) nil t)))
(defun diff-hl--ensure-staging-supported ()
(let ((backend (vc-backend buffer-file-name)))
(let ((backend (vc-backend (diff-hl--buffer-file-name))))
(unless (eq backend 'Git)
(user-error "Only Git supports staging; this file is controlled by %s" backend))))
@@ -1173,7 +1185,7 @@ Only supported with Git."
(diff-hl--ensure-staging-supported)
(diff-hl-find-current-hunk)
(let* ((line (line-number-at-pos))
(file buffer-file-name)
(file (diff-hl--buffer-file-name))
(dest-buffer (get-buffer-create " *diff-hl-stage*"))
(orig-buffer (current-buffer))
;; FIXME: If the file name has double quotes, these need to be quoted.
@@ -1186,9 +1198,7 @@ Only supported with Git."
diff-hl-update-async)
(diff-hl-diff-buffer-with-reference file dest-buffer nil 3))
(with-current-buffer dest-buffer
(with-no-warnings
(let (diff-auto-refine-mode)
(diff-hl-diff-skip-to line)))
(diff-hl-diff-skip-to line)
(let ((inhibit-read-only t))
(diff-hl-split-away-changes 3)
(save-excursion
@@ -1214,13 +1224,14 @@ Only supported with Git."
Only supported with Git."
(interactive)
(unless buffer-file-name
(user-error "No current file"))
(diff-hl--ensure-staging-supported)
(vc-git-command nil 0 buffer-file-name "reset")
(message "Unstaged all")
(unless diff-hl-show-staged-changes
(diff-hl-update)))
(let ((file (diff-hl--buffer-file-name)))
(unless file
(user-error "No current file"))
(diff-hl--ensure-staging-supported)
(vc-git-command nil 0 file "reset")
(message "Unstaged all")
(unless diff-hl-show-staged-changes
(diff-hl-update))))
(defun diff-hl-stage-dwim (&optional with-edit)
"Stage the current hunk or choose the hunks to stage.
@@ -1247,7 +1258,7 @@ Pops up a diff buffer that can be edited to choose the changes to stage."
(diff-hl--ensure-staging-supported)
(let* ((line-beg (and beg (line-number-at-pos beg t)))
(line-end (and end (line-number-at-pos end t)))
(file buffer-file-name)
(file (diff-hl--buffer-file-name))
(dest-buffer (get-buffer-create "*diff-hl-stage-some*"))
(orig-buffer (current-buffer))
(diff-hl-update-async nil)
@@ -1391,14 +1402,14 @@ The value of this variable is a mode line template as in
(declare-function smartrep-define-key 'smartrep)
(let (smart-keys)
(cl-labels ((scan (map)
(map-keymap
(lambda (event binding)
(if (consp binding)
(scan binding)
(when (and (characterp event)
(not (memq binding diff-hl-repeat-exceptions)))
(push (cons (string event) binding) smart-keys))))
map)))
(map-keymap
(lambda (event binding)
(if (consp binding)
(scan binding)
(when (and (characterp event)
(not (memq binding diff-hl-repeat-exceptions)))
(push (cons (string event) binding) smart-keys))))
map)))
(scan diff-hl-command-map)
(smartrep-define-key diff-hl-mode-map diff-hl-command-prefix smart-keys))))
@@ -1423,22 +1434,24 @@ The value of this variable is a mode line template as in
(let* ((topdir (magit-toplevel))
(modified-files
(magit-git-items "diff-tree" "-z" "--name-only" "-r" "HEAD~" "HEAD"))
(unmodified-states '(up-to-date ignored unregistered)))
(unmodified-states '(up-to-date ignored unregistered))
file)
(dolist (buf (buffer-list))
(when (and (buffer-local-value 'diff-hl-mode buf)
(not (buffer-modified-p buf))
;; Solve the "cloned indirect buffer" problem
;; (diff-hl-mode could be non-nil there, even if
;; buffer-file-name is nil):
(buffer-file-name buf)
(file-in-directory-p (buffer-file-name buf) topdir)
(file-exists-p (buffer-file-name buf)))
(setq file (diff-hl--buffer-file-name buf))
(when (and
(buffer-local-value 'diff-hl-mode buf)
(not (buffer-modified-p buf))
;; Solve the "cloned indirect buffer" problem
;; (diff-hl-mode could be non-nil there, even if
;; buffer-file-name is nil):
file
(file-in-directory-p file topdir)
(file-exists-p file))
(with-current-buffer buf
(let* ((file buffer-file-name)
(backend (vc-backend file)))
(let* ((backend (vc-backend file)))
(when backend
(cond
((member file modified-files)
((member (file-relative-name file topdir) modified-files)
(when (memq (vc-state file) unmodified-states)
(vc-state-refresh file backend))
(diff-hl-update))
@@ -1519,11 +1532,15 @@ The diffs are computed in the buffer DEST-BUFFER. This requires
the `diff-program' to be in your `exec-path'.
CONTEXT-LINES is the size of the unified diff context, defaults to 0."
(require 'diff)
(vc-ensure-vc-buffer)
(unless file
(error "Buffer %s is not visiting a file" (buffer-name)))
(setq backend (or backend (vc-backend file)))
(unless backend
(error "File %s is not under version control" file))
(save-current-buffer
(let* ((dest-buffer (or dest-buffer "*diff-hl-diff-buffer-with-reference*"))
(backend (or backend (vc-backend file)))
(temporary-file-directory diff-hl-temporary-directory)
(enable-local-variables nil)
(rev
(if (and (eq backend 'Git)
(not diff-hl-reference-revision)
@@ -1537,7 +1554,7 @@ CONTEXT-LINES is the size of the unified diff context, defaults to 0."
backend
(or diff-hl-reference-revision
(assoc-default backend diff-hl-head-revision-alist)))
(diff-hl-working-revision buffer-file-name backend)))))
(diff-hl-working-revision (diff-hl--buffer-file-name) backend)))))
(switches (format "-U %d --strip-trailing-cr" (or context-lines 0))))
(diff-no-select rev (current-buffer) switches (not (diff-hl--use-async-p))
(get-buffer-create dest-buffer))
@@ -1566,7 +1583,8 @@ CONTEXT-LINES is the size of the unified diff context, defaults to 0."
(goto-char (point-min))
(buffer-substring-no-properties (point) (line-end-position))))
((eq backend 'JJ)
(car (last (vc-jj--process-lines "log" "--no-graph"
(car (last (vc-jj--process-lines nil
"log" "--no-graph"
"-r" revision
"-T" "change_id" "-n" "1"))))
(t
@@ -1605,13 +1623,14 @@ CONTEXT-LINES is the size of the unified diff context, defaults to 0."
;;;###autoload
(defun turn-on-diff-hl-mode ()
"Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
(cond
(buffer-file-name
(unless (and diff-hl-disable-on-remote
(file-remote-p buffer-file-name))
(diff-hl-mode 1)))
((eq major-mode 'vc-dir-mode)
(diff-hl-dir-mode 1))))
(let ((file (diff-hl--buffer-file-name)))
(cond
(file
(unless (and diff-hl-disable-on-remote
(file-remote-p file))
(diff-hl-mode 1)))
((eq major-mode 'vc-dir-mode)
(diff-hl-dir-mode 1)))))
;;;###autoload
(defun diff-hl--global-turn-on ()
@@ -1729,11 +1748,15 @@ effect."
(message "Showing changes against %s (project %s)" rev name)))))
(defun diff-hl--project-root (proj)
;; Emacs 26 and 27 don't have `project-root'.
;; Emacs 27 does not have `project-root'.
(expand-file-name (static-if (>= emacs-major-version 28)
(project-root proj)
(project-roots proj))))
;; Commands below will only work with recent enough project.el.
(declare-function project-name "project")
(declare-function project-buffers "project")
(defun diff-hl-set-reference-rev-in-project-internal (rev proj)
(let* ((root (diff-hl--project-root proj)))
;; newly opened files will share this value
lisp/emacsql/emacsql-compiler.el
+4 -5
View File
@@ -81,7 +81,7 @@
(defun emacsql-quote-identifier (string)
"Double-quote (identifier) STRING for use in a SQL expression."
(format "\"%s\"" (replace-regexp-in-string "\"" "\"\"" string)))
(format "\"%s\"" (string-replace "\"" "\"\"" string)))
(defun emacsql-escape-identifier (identifier)
"Escape an identifier, if needed, for SQL."
@@ -99,7 +99,7 @@
(if (string-match-p ":" name)
(mapconcat #'emacsql-escape-identifier
(mapcar #'intern (split-string name ":")) ".")
(let ((print (replace-regexp-in-string "-" "_" (format "%S" identifier)))
(let ((print (string-replace "-" "_" (format "%S" identifier)))
(special "[]-\000-\040!\"#%&'()*+,./:;<=>?@[\\^`{|}~\177]"))
(if (or (string-match-p special print)
(string-match-p "^[0-9$]" print)
@@ -133,7 +133,7 @@
(defun emacsql-escape-format (thing)
"Escape THING for use as a `format' spec."
(replace-regexp-in-string "%" "%%" thing))
(string-replace "%" "%%" thing))
;;; Schema compiler
@@ -146,8 +146,7 @@
(defun emacsql--from-keyword (keyword)
"Convert KEYWORD into SQL."
(let ((name (substring (symbol-name keyword) 1)))
(upcase (replace-regexp-in-string "-" " " name))))
(upcase (string-replace "-" " " (substring (symbol-name keyword) 1))))
(defun emacsql--prepare-constraints (constraints)
"Compile CONSTRAINTS into a partial SQL expression."
lisp/emacsql/emacsql-pg.el
+10 -12
View File
@@ -10,8 +10,7 @@
;;; Commentary:
;; This library provides an EmacSQL back-end for PostgreSQL, which
;; uses the `pg' package to directly speak to the database. This
;; library requires at least Emacs 28.1.
;; uses the `pg' package to directly speak to the database.
;; (For an alternative back-end for PostgreSQL, see `emacsql-psql'.)
@@ -19,14 +18,10 @@
(require 'emacsql)
(if (>= emacs-major-version 28)
(require 'pg nil t)
(message "emacsql-pg.el requires Emacs 28.1 or later"))
(declare-function pg-connect "ext:pg"
( dbname user &optional
(password "") (host "localhost") (port 5432) (tls nil)))
(require 'pg nil t)
(declare-function pg-connect-plist "ext:pg")
(declare-function pg-disconnect "ext:pg" (con))
(declare-function pg-exec "ext:pg" (connection &rest args))
(declare-function pg-exec "ext:pg" (con &rest args))
(declare-function pg-result "ext:pg" (result what &rest arg))
(defclass emacsql-pg-connection (emacsql-connection)
@@ -41,11 +36,14 @@
(nil "TEXT"))))
"A connection to a PostgreSQL database via pg.el.")
(cl-defun emacsql-pg (dbname user &key
(host "localhost") (password "") (port 5432) debug)
(cl-defun emacsql-pg ( dbname user &key
(host "localhost") (password nil) (port 5432) debug)
"Connect to a PostgreSQL server using pg.el."
(require 'pg)
(let* ((pgcon (pg-connect dbname user password host port))
(let* ((pgcon (pg-connect-plist dbname user
:password password
:host host
:port port))
(connection (make-instance 'emacsql-pg-connection
:handle (and (fboundp 'pgcon-process)
(pgcon-process pgcon))
lisp/emacsql/emacsql-pkg.el
+4 -4
View File
@@ -1,9 +1,9 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "emacsql" "20260401.1220"
(define-package "emacsql" "20260601.1722"
"High-level SQL database front-end."
'((emacs "26.1"))
'((emacs "28.1"))
:url "https://github.com/magit/emacsql"
:commit "2fe6d4562b32a170a750d5e80514fbb6b6694803"
:revdesc "2fe6d4562b32"
:commit "d811bbefcb5e27841af55cae53aa939ba720de77"
:revdesc "d811bbefcb5e"
:authors '(("Christopher Wellons" . "wellons@nullprogram.com"))
:maintainers '(("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")))
lisp/emacsql/emacsql.el
+4 -4
View File
@@ -6,9 +6,9 @@
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 20260401.1220
;; Package-Revision: 2fe6d4562b32
;; Package-Requires: ((emacs "26.1"))
;; Package-Version: 20260601.1722
;; Package-Revision: d811bbefcb5e
;; Package-Requires: ((emacs "28.1"))
;; SPDX-License-Identifier: Unlicense
@@ -38,7 +38,7 @@
"The EmacSQL SQL database front-end."
:group 'comm)
(defconst emacsql-version "4.3.6")
(defconst emacsql-version "4.4.1")
(defvar emacsql-global-timeout 30
"Maximum number of seconds to wait before bailing out on a SQL command.
lisp/ess/ess-bugs-d.el
+7 -6
View File
@@ -59,9 +59,9 @@
font-lock-keyword-face)
(cons (concat "\\<d\\(bern\\|beta\\|bin\\|binom\\|"
"cat\\|chisq\\|chisqr\\|CRP\\|"
"car_normal\\|car_proper\\|cat\\|chisq\\|chisqr\\|CRP\\|"
"dexp\\|dirch\\|dirich\\|"
"exp\\|\\(gen[.]\\|inv\\)?gamma\\|hyper\\|"
"exp\\|flat\\|\\(gen[.]\\|inv\\)?gamma\\|halfflat\\|hyper\\|"
"interval\\|lkj_corr_cholesky\\|laplace\\|lnorm\\|logis\\|"
"mnorm\\|mt\\|multi\\|multinom\\|mvt\\|"
"negbin\\|nbinom\\|norm\\(mix\\)?\\|par\\|pois\\|sum\\|t\\|"
@@ -71,14 +71,15 @@
(cons (concat "\\<\\(abs\\|acos\\|acosh\\|asin\\|asinh\\|atan\\|atanh\\|"
"asCol\\|asRow\\|backsolve\\|besselK\\|ceiling\\|chol\\|"
"cos\\|C\\|dim\\|\\(i\\)?cloglog\\|cube\\|"
"equals\\|exp\\|expm\\|expAv\\|expit\\|"
"eigen\\|equals\\|exp\\|expm\\|expAv\\|expit\\|"
"floor\\|for\\|forwardsolve\\|"
"inprod\\|interp[.]lin\\(e\\)?\\|inverse\\|"
"lgamma\\|length\\|lfactorial\\|"
"log\\|log1p\\|\\(i\\)?logit\\|logdet\\|logfact\\|loggam\\|"
"max\\|mean\\|mexp\\|min\\|pmax\\|pmin\\|"
"phi\\|pow\\|\\(i\\)?probit\\|prod\\|rank\\|ranked\\|round\\|"
"sd\\|sin\\|solve\\|sort\\|sqrt\\|step\\|sum\\|"
"max\\|mean\\|mexp\\|min\\|order\\|"
"pmax\\|pmin\\|phi\\|pow\\|\\(i\\)?probit\\|prod\\|"
"rank\\|ranked\\|round\\|"
"sd\\|sin\\|solve\\|sort\\|sqrt\\|step\\|sum\\|svd\\|"
"t\\|tan\\|trunc\\|T\\)[ \t\n]*(")
font-lock-function-name-face)
lisp/ess/ess-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ess" "20260322.1703"
(define-package "ess" "20260526.1432"
"Emacs Speaks Statistics."
'((emacs "25.1"))
:url "https://ess.r-project.org/"
:commit "4e112590d1c13cfe464ca7de77837f1b956e4a9f"
:revdesc "4e112590d1c1"
:commit "da7d7dc1d2cf95760f56cb1763eb543c4dadaa0c"
:revdesc "da7d7dc1d2cf"
:authors '(("David Smith" . "dsmith@stats.adelaide.edu.au")
("A.J. Rossini" . "blindglobe@gmail.com")
("Richard M. Heiberger" . "rmh@temple.edu")
lisp/ess/ess-r-flymake.el
+1 -1
View File
@@ -142,7 +142,7 @@ Otherwise, construct a string to pass to lintr::linters_with_defaults."
(when (re-search-forward "@@\\(\\(error\\|warning\\): \\)@@" nil t)
(let ((type (ess-r--flymake-msg-type (match-string 1)))
(msg (buffer-substring-no-properties (match-end 0) (point-max))))
(flymake-log type msg)
(flymake-log type "%s" msg)
(eq type :error))))
(defun ess-r--flymake-parse-output (msg-buffer src-buffer report-fn)
lisp/ess/ess-r-syntax.el
+2 -1
View File
@@ -1,6 +1,6 @@
;;; ess-r-syntax.el --- Utils to work with R code -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
;; Copyright (C) 2015-2026 Free Software Foundation, Inc.
;; Author: Lionel Henry <lionel.hry@gmail.com>
;; Created: 12 Oct 2015
;; Maintainer: ESS-core <ESS-core@r-project.org>
@@ -310,6 +310,7 @@ content. Return nil when the end of the buffer is reached."
(defvar ess-r-operators-list
'("+" "-" "*" "/" "%%" "**" "^"
"%*%" "%/%" "%in%" "%notin%" "%o%" "%x%" "%||%" ; = ls(pattern = "^%", baseenv())
"&" "&&" "|" "||" "!" "?" "~"
"==" "!=" "<" "<=" ">=" ">"
"=" "<-" "<<-" "->" "->>"
lisp/ess/ess-roxy.el
+5 -1
View File
@@ -713,7 +713,11 @@ block before the point."
(save-excursion
(let ((end-of-entry (ess-roxy-end-of-entry))
(beg-of-entry (ess-roxy-beg-of-entry)))
(hs-hide-block-at-point nil (list beg-of-entry end-of-entry)))))
(if (= (cdr (func-arity 'hs-hide-block-at-point)) 1)
;; Emacs 31 ++ signature: single optional COMMENT-REG -- <GH>/emacs-ess/ESS/issues/1334
(hs-hide-block-at-point (list beg-of-entry end-of-entry))
;; Emacs <= 30.x signature: (END-OF-BLOCK &optional COMMENT-REG)
(hs-hide-block-at-point nil (list beg-of-entry end-of-entry))))))
(defun ess-roxy-toggle-hiding ()
"Toggle hiding/showing of a block.
lisp/ess/ess.el
+2 -2
View File
@@ -17,8 +17,8 @@
;;
;; Maintainer: ESS Core Team <ESS-core@r-project.org>
;; Created: 7 Jan 1994
;; Package-Version: 20260322.1703
;; Package-Revision: 4e112590d1c1
;; Package-Version: 20260526.1432
;; Package-Revision: da7d7dc1d2cf
;; URL: https://ess.r-project.org/
;; Package-Requires: ((emacs "25.1"))
;; ESSR-Version: 1.8
lisp/ess/ess.info
+1 -1
View File
@@ -14,7 +14,7 @@ File: ess.info, Node: Top, Next: Introduction, Up: (dir)
ESS: Emacs Speaks Statistics
****************************
ESS version 26.01.0
ESS version 26.05.0
by A.J. Rossini,
R.M. Heiberger,
lisp/ess/etc/ESSR/R/completion.R
+1
View File
@@ -108,6 +108,7 @@ local({
}
## builds on R`s functionality in src/library/utils/R/completion.R :
.ess_get_completions <- function(string, end, suffix = " = ") {
oldopts <- utils::rc.options(funarg.suffix = suffix)
on.exit(utils::rc.options(oldopts))
lisp/flycheck-posframe/flycheck-posframe-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "flycheck-posframe" "20220715.133"
(define-package "flycheck-posframe" "20260409.14"
"Show flycheck error messages using posframe.el."
'((flycheck "0.24")
(emacs "26")
(posframe "0.7.0"))
:url "https://github.com/alexmurray/flycheck-posframe"
:commit "19896b922c76a0f460bf3fe8d8ebc2f9ac9028d8"
:revdesc "19896b922c76"
:commit "aeccb14e90ba25f45e1919b776777fc6ec95e251"
:revdesc "aeccb14e90ba"
:authors '(("Alex Murray" . "murray.alex@gmail.com"))
:maintainers '(("Alex Murray" . "murray.alex@gmail.com")))
lisp/flycheck-posframe/flycheck-posframe.el
+9 -3
View File
@@ -5,8 +5,8 @@
;; Author: Alex Murray <murray.alex@gmail.com>
;; Maintainer: Alex Murray <murray.alex@gmail.com>
;; URL: https://github.com/alexmurray/flycheck-posframe
;; Package-Version: 20220715.133
;; Package-Revision: 19896b922c76
;; Package-Version: 20260409.14
;; Package-Revision: aeccb14e90ba
;; Package-Requires: ((flycheck "0.24") (emacs "26") (posframe "0.7.0"))
;; This file is not part of GNU Emacs.
@@ -199,6 +199,10 @@ Only the `foreground' is used in this face."
"Hide posframe if position has changed since last display."
(not (flycheck-posframe-check-position)))
(defun flycheck-posframe-point-position-p ()
"Return non-nil if `flycheck-posframe-position' is a point-based position."
(string-prefix-p "point-" (symbol-name flycheck-posframe-position)))
(defun flycheck-posframe-show-posframe (errors)
"Display ERRORS, using posframe.el library."
(posframe-hide flycheck-posframe-buffer)
@@ -218,7 +222,9 @@ Only the `foreground' is used in this face."
(flycheck-posframe-highest-error-level-face errors)
'flycheck-posframe-border-face) nil t)
:poshandler poshandler
:hidehandler #'flycheck-posframe-hidehandler))))
:hidehandler #'flycheck-posframe-hidehandler
:y-pixel-offset (when (flycheck-posframe-point-position-p)
flycheck-posframe-border-width)))))
;;;###autoload
(defun flycheck-posframe-configure-pretty-defaults ()
lisp/flycheck/flycheck-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "flycheck" "20260320.1715"
(define-package "flycheck" "20260604.2002"
"On-the-fly syntax checking."
'((emacs "27.1")
(seq "2.24"))
:url "https://github.com/flycheck/flycheck"
:commit "0e5eb8300d32fd562724216c19eaf199ee1451ab"
:revdesc "0e5eb8300d32"
:commit "96f1852c7e352c969393e6e66176178177e933be"
:revdesc "96f1852c7e35"
:keywords '("convenience" "languages" "tools")
:authors '(("Sebastian Wiesner" . "swiesner@lunaryorn.com"))
:maintainers '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com")
lisp/flycheck/flycheck.el
+23 -8
View File
@@ -10,8 +10,8 @@
;; Bozhidar Batsov <bozhidar@batsov.dev>
;; URL: https://github.com/flycheck/flycheck
;; Keywords: convenience, languages, tools
;; Package-Version: 20260320.1715
;; Package-Revision: 0e5eb8300d32
;; Package-Version: 20260604.2002
;; Package-Revision: 96f1852c7e35
;; Package-Requires: ((emacs "27.1") (seq "2.24"))
;; This file is not part of GNU Emacs.
@@ -6268,8 +6268,12 @@ PROCESS, and terminates standard input with EOF."
;; can easily use pipes.
(process-connection-type nil)
;; Force English messages from checker processes so that
;; error patterns can match reliably.
(process-environment (cons "LC_ALL=C" process-environment)))
;; error patterns can match reliably. We set LC_MESSAGES
;; rather than LC_ALL so that the character encoding
;; (LC_CTYPE) is left untouched; using LC_ALL=C forces an
;; ASCII locale that breaks checkers reading UTF-8 input,
;; such as hledger (see #2170).
(process-environment (cons "LC_MESSAGES=C" process-environment)))
;; We do not associate the process with any buffer, by
;; passing nil for the BUFFER argument of `start-process'.
;; Instead, we just remember the buffer being checked in a
@@ -7527,7 +7531,7 @@ See URL `https://asciidoctor.org'."
(warning line-start
"asciidoctor: WARNING: <stdin>: Line " line ": " (message)
line-end))
:modes adoc-mode)
:modes (adoc-mode asciidoc-mode))
(defun flycheck-awk-gawk-fix-message (err)
"Remove the repeated file-name/line from the error message of ERR."
@@ -7553,7 +7557,10 @@ See URL `https://asciidoctor.org'."
"GNU awk's built-in --lint checker."
:command ("gawk"
;; Avoid code execution. See https://github.com/w0rp/ale/pull/1411
"--source" "BEGIN{exit} END{exit 1}"
;; The BEGIN/END blocks short-circuit the script's own rules so
;; only linting happens; exit 0 so that valid scripts don't get
;; flagged as a suspicious non-zero exit.
"--source" "BEGIN{exit} END{exit}"
"-f" source
"--lint"
"/dev/null")
@@ -8549,6 +8556,10 @@ See `https://credo-ci.org/'."
;; file-local eval: directives during byte-compilation.
(setq enable-local-eval nil
enable-local-variables :safe)
;; The subprocess only byte-compiles to collect warnings; producing
;; .eln files is a wasted side effect that also pollutes the user's
;; native-comp cache, so disable native compilation entirely.
(setq no-native-compile t)
;; Keep track of the generated bytecode files, to delete them after byte
;; compilation.
(require 'bytecomp)
@@ -10771,7 +10782,11 @@ See URL `https://docs.astral.sh/ruff/'."
line-end)
(warning line-start
(or "-" (file-name)) ":" line ":" (optional column ":") " "
(id (one-or-more (any alpha)) (one-or-more digit)) " "
;; ruff >= 0.15.7 in preview mode wraps the rule code in a
;; severity tag, e.g. "error[F401]" instead of just "F401"
(optional (one-or-more (any alpha)) "[")
(id (one-or-more (any alpha)) (one-or-more digit))
(optional "]") " "
(message (one-or-more not-newline))
line-end))
:error-explainer flycheck-python-ruff-explainer
@@ -12488,7 +12503,7 @@ See URL `https://textlint.github.io/'."
;; user to add mode->plugin mappings manually in
;; `flycheck-textlint-plugin-alist'.
:modes
(text-mode markdown-mode gfm-mode message-mode adoc-mode
(text-mode markdown-mode gfm-mode message-mode adoc-mode asciidoc-mode
mhtml-mode latex-mode LaTeX-mode org-mode rst-mode)
:enabled
(lambda () (flycheck--textlint-get-plugin))
lisp/gnuplot/gnuplot-context.el
+3 -3
View File
@@ -612,7 +612,7 @@ name; otherwise continues tokenizing up to the token at point. FIXME."
(let ((name (car chunk))
(code (cdr chunk)))
(setf (aref object-code i) `(label ,name))
(cl-incf i)
(incf i)
(puthash name i name->offset)
(while code
(setf (aref object-code i) (car code)
@@ -1770,8 +1770,8 @@ there."
(when start-symbol ; HACK FIXME
(let ((look-for `(label ,start-symbol)))
(while (not (equal (aref instructions pc) look-for))
(cl-incf pc))
(cl-incf pc)))
(incf pc))
(incf pc)))
(setq gnuplot-context--completions nil
gnuplot-context--eldoc nil
lisp/gnuplot/gnuplot-pkg.el
+5 -5
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "gnuplot" "20260322.20"
(define-package "gnuplot" "20260623.1111"
"Major-mode and interactive frontend for gnuplot."
'((emacs "28.1")
(compat "30"))
'((emacs "29.1")
(compat "31"))
:url "https://github.com/emacs-gnuplot/gnuplot"
:commit "39ba1dec5e8e227ba093a30ca07b20d8eb038f29"
:revdesc "39ba1dec5e8e"
:commit "81e3cb30297f0d12df41b865d2a76c8ba179089c"
:revdesc "81e3cb30297f"
:keywords '("data" "gnuplot" "plotting")
:maintainers '(("Maxime Tréca" . "maxime@gmail.com")
("Daniel Mendler" . "mail@daniel-mendler.de")))
lisp/gnuplot/gnuplot.el
+3 -3
View File
@@ -5,11 +5,11 @@
;; Author: Jon Oddie, Bruce Ravel, Phil Type
;; Maintainer: Maxime Tréca <maxime@gmail.com>, Daniel Mendler <mail@daniel-mendler.de>
;; Created: 1998
;; Package-Version: 20260322.20
;; Package-Revision: 39ba1dec5e8e
;; Package-Version: 20260623.1111
;; Package-Revision: 81e3cb30297f
;; Keywords: data gnuplot plotting
;; URL: https://github.com/emacs-gnuplot/gnuplot
;; Package-Requires: ((emacs "28.1") (compat "30"))
;; Package-Requires: ((emacs "29.1") (compat "31"))
;; 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
lisp/indent-guide/indent-guide-pkg.el
+4 -4
View File
@@ -1,7 +1,7 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "indent-guide" "20260211.1005"
(define-package "indent-guide" "20260515.1152"
"Show vertical lines to guide indentation."
()
:url "http://hins11.yu-yake.com/"
:commit "f3455c6c798b568a6ea1013b7eea1153d2e092be"
:revdesc "f3455c6c798b")
:url "http://zk-phi.github.io/"
:commit "ab71cac290505caf6c374cb8594b0b78d5109af1"
:revdesc "ab71cac29050")
lisp/indent-guide/indent-guide.el
+59 -39
View File
@@ -17,9 +17,9 @@
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
;; Author: zk_phi
;; URL: http://hins11.yu-yake.com/
;; Package-Version: 20260211.1005
;; Package-Revision: f3455c6c798b
;; URL: http://zk-phi.github.io/
;; Package-Version: 20260515.1152
;; Package-Revision: ab71cac29050
;;; Commentary:
@@ -71,12 +71,13 @@
;; 2.2.0 add option "indent-guide-threshold"
;; 2.3.0 use regexp search to find the beginning of level
;; 2.3.1 add option "indent-guide-lispy-modes"
;; 2.4.0 add option "indent-guide-char-top" and "-bottom"
;;; Code:
(require 'cl-lib)
(defconst indent-guide-version "2.4")
(defconst indent-guide-version "2.4.0")
;; * customs
@@ -146,14 +147,6 @@ blocks are NOT placed at beginning of line."
;; * utilities
(defun indent-guide--active-overlays ()
"Return the list of all overlays created by indent-guide."
(delq nil
(mapcar
(lambda (ov)
(and (eq (overlay-get ov 'category) 'indent-guide) ov))
(overlays-in (point-min) (point-max)))))
(defun indent-guide--indentation-candidates (level)
"*Internal function for `indent-guide--beginning-of-level'."
(cond ((<= level 0)
@@ -169,21 +162,39 @@ blocks are NOT placed at beginning of line."
(cons (make-string level ?\s)
(indent-guide--indentation-candidates (1- level))))))
;; Note(vmargb): `indent-guide--beginning-of-level' is called repeatedly
;; even within the same indentation level when the cursor is moved around
;; so we cache and reuse it until the user changes to another indent level
(defvar-local indent-guide--regex-cache nil
"Stores the last computed regex with the inputs used to build it.
Format: ((BASE-LEVEL . TAB-WIDTH) . REGEX-STRING).")
(defun indent-guide--beginning-of-level ()
"Move to the beginning of current indentation level and return
the point. When no such points are found, just return nil."
the point. When no such points are found, just return nil."
(back-to-indentation)
(let* ((base-level (if (not (eolp))
(current-column)
(max (save-excursion
(skip-chars-forward "\s\t\n")
(skip-chars-forward " \t\n")
(current-column))
(save-excursion
(skip-chars-backward "\s\t\n")
(skip-chars-backward " \t\n")
(back-to-indentation)
(current-column)))))
(candidates (indent-guide--indentation-candidates (1- base-level)))
(regex (concat "^" (regexp-opt candidates t) "[^\s\t\n]")))
(cache-key (cons base-level tab-width)) ; key: indent depth & tab width
;; check if current inputs match regex-cache
(regex (if (equal (car indent-guide--regex-cache) cache-key)
(cdr indent-guide--regex-cache) ; reuse regex string
; recompute regex
(let ((candidates (indent-guide--indentation-candidates
(1- base-level))))
(setq indent-guide--regex-cache
(cons cache-key
(concat "^"
(regexp-opt candidates t)
"[^ \t\n]")))
(cdr indent-guide--regex-cache)))))
(unless (zerop base-level)
(and (search-backward-regexp regex nil t)
(goto-char (match-end 1))))))
@@ -220,7 +231,7 @@ the point. When no such points are found, just return nil."
(lambda (ov)
(when (eq (overlay-get ov 'category) 'indent-guide)
ov))
(overlays-in (point) (point))))
(overlays-at (point))))
;; we already have an overlay here => append to the existing overlay
;; (important when "recursive" is enabled)
(setq string (let ((str (overlay-get ov 'before-string)))
@@ -278,11 +289,11 @@ the point. When no such points are found, just return nil."
(interactive)
;;; NOTE(arka): redraw only when needed
(unless (active-minibuffer-window)
(indent-guide-remove)
(let ((win-start (window-start))
(win-end (window-end nil t))
line-col line-start line-end)
;;; only clear overlays in the visible viewport
(indent-guide-remove win-start win-end)
;; decide line-col, line-start
(save-excursion
(indent-guide--beginning-of-level)
@@ -313,21 +324,20 @@ the point. When no such points are found, just return nil."
(indent-guide--make-overlay (+ line-start tmp) line-col line-start line-end))
(remove-overlays (point) (point) 'category 'indent-guide)))))
(defun indent-guide-remove ()
(dolist (ov (indent-guide--active-overlays))
(delete-overlay ov)))
;; use built-in `remove-overlays'
(defun indent-guide-remove (&optional beg end)
"Remove indent-guide overlays between BEG and END.
Defaults to the whole buffer if not provided."
(remove-overlays (or beg (point-min)) (or end (point-max))
'category 'indent-guide))
;; * minor-mode
(defun indent-guide-post-command-hook ()
(if (null indent-guide-delay)
(indent-guide-show)
(when (null indent-guide--timer-object)
(setq indent-guide--timer-object
(run-with-idle-timer indent-guide-delay nil
(lambda ()
(indent-guide-show)
(setq indent-guide--timer-object nil)))))))
;; use named function to prevent a lambda closure being
;; allocated repeatedly on every debounce
(defun indent-guide--run-timer ()
(indent-guide-show)
(setq indent-guide--timer-object nil))
;;; NOTE(arka): root cause of flickering effect. we don't actually need
;;; pre-hook to redraw guides on each command.
@@ -336,9 +346,19 @@ the point. When no such points are found, just return nil."
;; ;; remove all overlays in pre-command-hook.
;; (indent-guide-remove))
;;; NOTE(arka): fn to fix flickering effect when scrolling.
(defun indent-guide--window-scroll-hook (&rest _)
(indent-guide-show))
;; Note(vmargb): the timer now behaves like a proper `debounce'
;; every new command cancels the old idle timer and schedules a new one
;; so `indent-guide-show' only runs after the user has paused, not after
;; the first command in a burst.
;; Used by both hooks: `post-command-hook' & `window-scroll-functions'.
(defun indent-guide--request-show (&rest _)
(if (null indent-guide-delay)
(indent-guide-show) ; no delay, show immediately
(when indent-guide--timer-object ; is delay, so cancel/debounce
(cancel-timer indent-guide--timer-object))
(setq indent-guide--timer-object ; schedule new timer
(run-with-idle-timer indent-guide-delay nil
#'indent-guide--run-timer))))
;;;###autoload
(define-minor-mode indent-guide-mode
@@ -349,10 +369,10 @@ the point. When no such points are found, just return nil."
(if indent-guide-mode
(progn
;;; NOTE(arka): only use post-hook. pre-hook is now depricated
(add-hook 'post-command-hook 'indent-guide-post-command-hook nil t)
(add-hook 'window-scroll-functions 'indent-guide--window-scroll-hook nil t))
(remove-hook 'post-command-hook 'indent-guide-post-command-hook t)
(remove-hook 'window-scroll-functions 'indent-guide--window-scroll-hook t)))
(add-hook 'post-command-hook 'indent-guide--request-show nil t)
(add-hook 'window-scroll-functions 'indent-guide--request-show nil t))
(remove-hook 'post-command-hook 'indent-guide--request-show t)
(remove-hook 'window-scroll-functions 'indent-guide--request-show t)))
;;;###autoload
(define-globalized-minor-mode indent-guide-global-mode
lisp/ivy/ivy-autoloads.el
+1 -1
View File
@@ -35,7 +35,7 @@ PREDICATE is applied to filter out the COLLECTION immediately.
This argument is for compatibility with `completing-read'.
When REQUIRE-MATCH is non-nil, only members of COLLECTION can be
selected. In can also be a lambda.
selected. It can also be a lambda.
If INITIAL-INPUT is non-nil, then insert that input in the
minibuffer initially.
lisp/ivy/ivy-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ivy" "20260318.1355"
(define-package "ivy" "20260413.2102"
"Incremental Vertical completYon."
'((emacs "24.5"))
:url "https://github.com/abo-abo/swiper"
:commit "1005bff8a700b92dc464f770aff8a0db5b4a1c0b"
:revdesc "1005bff8a700"
:commit "0d02f5063d36ff4fa6138f0973c83c6d3874fba0"
:revdesc "0d02f5063d36"
:keywords '("matching")
:authors '(("Oleh Krehel" . "ohwoeowho@gmail.com"))
:maintainers '(("Basil L. Contovounesios" . "basil@contovou.net")))
lisp/ivy/ivy.el
+3 -3
View File
@@ -5,8 +5,8 @@
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Basil L. Contovounesios <basil@contovou.net>
;; URL: https://github.com/abo-abo/swiper
;; Package-Version: 20260318.1355
;; Package-Revision: 1005bff8a700
;; Package-Version: 20260413.2102
;; Package-Revision: 0d02f5063d36
;; Package-Requires: ((emacs "24.5"))
;; Keywords: matching
@@ -2200,7 +2200,7 @@ PREDICATE is applied to filter out the COLLECTION immediately.
This argument is for compatibility with `completing-read'.
When REQUIRE-MATCH is non-nil, only members of COLLECTION can be
selected. In can also be a lambda.
selected. It can also be a lambda.
If INITIAL-INPUT is non-nil, then insert that input in the
minibuffer initially.
lisp/ledger-mode/ledger-check.el
+3 -2
View File
@@ -69,7 +69,8 @@
;; one will ever have an account named "e342asd2131". If
;; someones does, this will probably still work for them.
;; I should only highlight error and warning lines.
"ledger bal e342asd2131 --strict --explicit "
(format "%s bal e342asd2131 --strict --explicit "
(shell-quote-argument ledger-binary-path))
t nil)
(goto-char data-pos)
@@ -88,7 +89,7 @@
(point-marker))))))
(add-text-properties (line-beginning-position) (line-end-position)
(list 'font-lock-face 'ledger-font-report-clickable-face))
(setq have-warnings 'true)
(setq have-warnings t)
(end-of-line))))
(if (not have-warnings)
(insert "No errors or warnings reported."))))
lisp/ledger-mode/ledger-complete.el
+2 -5
View File
@@ -84,7 +84,7 @@ If nil, full account names are offered for completion."
(sort (delete-dups payees-list) #'string-lessp)))
(defun ledger-payees-list ()
"Return a list of all known account names as strings.
"Return a list of all known payees as strings.
Looks in `ledger-payees-file' if set, otherwise the current buffer."
(if ledger-payees-file
(let ((f ledger-payees-file))
@@ -355,9 +355,6 @@ an alist (ACCOUNT-ELEMENT . NODE)."
(when (and realign-after ledger-post-auto-align)
(ledger-post-align-postings (line-beginning-position) (line-end-position)))))))))
(defun ledger-trim-trailing-whitespace (str)
(replace-regexp-in-string "[ \t]*$" "" str))
(defun ledger-comments-list ()
"Collect comments from the buffer."
(let ((comments '()))
@@ -379,7 +376,7 @@ Interactively, if point is after a payee, complete the
transaction with the details from the last transaction to that
payee."
(interactive)
(let* ((name (ledger-trim-trailing-whitespace
(let* ((name (string-trim-right
(buffer-substring
(save-excursion
(unless (eq (ledger-thing-at-point) 'transaction)
lisp/ledger-mode/ledger-context.el
+9
View File
@@ -183,31 +183,40 @@ specified line, returns nil."
(ledger-context-at-point)))))
(defun ledger-context-line-type (context-info)
"Return the line-type symbol component of CONTEXT-INFO."
(nth 0 context-info))
(defun ledger-context-current-field (context-info)
"Return the symbol naming the field at point in CONTEXT-INFO."
(nth 1 context-info))
(defun ledger-context-field-info (context-info field-name)
"Return the (FIELD VALUE POSITION) cell for FIELD-NAME in CONTEXT-INFO."
(assoc field-name (nth 2 context-info)))
(defun ledger-context-field-present-p (context-info field-name)
"Return non-nil if FIELD-NAME is present in CONTEXT-INFO."
(not (null (ledger-context-field-info context-info field-name))))
(defun ledger-context-field-value (context-info field-name)
"Return the string value of FIELD-NAME in CONTEXT-INFO."
(nth 1 (ledger-context-field-info context-info field-name)))
(defun ledger-context-field-position (context-info field-name)
"Return the buffer position of FIELD-NAME's start in CONTEXT-INFO."
(nth 2 (ledger-context-field-info context-info field-name)))
(defun ledger-context-field-end-position (context-info field-name)
"Return the buffer position one past FIELD-NAME's end in CONTEXT-INFO."
(+ (ledger-context-field-position context-info field-name)
(length (ledger-context-field-value context-info field-name))))
(defun ledger-context-goto-field-start (context-info field-name)
"Move point to the start of FIELD-NAME in CONTEXT-INFO."
(goto-char (ledger-context-field-position context-info field-name)))
(defun ledger-context-goto-field-end (context-info field-name)
"Move point one past the end of FIELD-NAME in CONTEXT-INFO."
(goto-char (ledger-context-field-end-position context-info field-name)))
(provide 'ledger-context)
lisp/ledger-mode/ledger-exec.el
+5
View File
@@ -35,6 +35,9 @@
(defvar ledger-works nil
"Non-nil if the ledger binary can support `ledger-mode' interactive features.")
(defvar ledger-exec--args-only nil
"Internal variable, used for testing.")
(defgroup ledger-exec nil
"Interface to the Ledger command-line accounting program."
:group 'ledger)
@@ -90,6 +93,8 @@ otherwise the error output is displayed and an error is raised."
(append (list (point-min) (point-max)
ledger-binary-path nil (list outbuf errfile) nil "-f" "-")
(list "--date-format" ledger-default-date-format)
(when ledger-exec--args-only
(list "--args-only"))
args)))))
(if (ledger-exec-success-p exit-code outbuf)
outbuf
lisp/ledger-mode/ledger-flymake.el
+8 -14
View File
@@ -33,10 +33,6 @@
(require 'ledger-exec) ; for `ledger-binary-path'
(require 'ledger-report) ; for `ledger-master-file'
;; To silence byte compiler warnings in Emacs 25 and older:
(declare-function flymake-diag-region "flymake" (buffer line &optional col))
(declare-function flymake-make-diagnostic "flymake" (buffer beg end type text &optional data overlay-properties))
(defvar-local ledger--flymake-proc nil)
(defcustom ledger-flymake-be-pedantic nil
@@ -114,14 +110,14 @@ Flymake calls this with REPORT-FN as needed."
(group-n 1 "Error: " (one-or-more not-newline) "\n"))
nil t)
for msg = (match-string 1)
for (beg . end) = (flymake-diag-region
source
(string-to-number (match-string 2)))
for type = :error
for region = (flymake-diag-region
source
(string-to-number (match-string 2)))
when region
collect (flymake-make-diagnostic source
beg
end
type
(car region)
(cdr region)
:error
msg)
into diags
finally (funcall report-fn diags)))
@@ -134,11 +130,9 @@ Flymake calls this with REPORT-FN as needed."
;;;###autoload
(defun ledger-flymake-enable ()
"Enable `flymake-mode' in `ledger-mode' buffers."
(unless (> emacs-major-version 25)
(error "Ledger-flymake requires Emacs version 26 or higher"))
;; Add `ledger-flymake' to `flymake-diagnostic-functions' so that flymake can
;; work in ledger-mode:
(add-hook 'flymake-diagnostic-functions 'ledger-flymake nil t)
(add-hook 'flymake-diagnostic-functions #'ledger-flymake nil t)
(flymake-mode))
(provide 'ledger-flymake)
lisp/ledger-mode/ledger-fonts.el
+2 -1
View File
@@ -307,7 +307,8 @@
(defface ledger-font-N-symbol-face
`((t :inherit default))
"Face for symbol in N directives")
"Face for symbol in N directives"
:group 'ledger-faces)
(defface ledger-font-payee-directive-face
`((t :inherit ledger-font-directive-face))
lisp/ledger-mode/ledger-init.el
+3 -1
View File
@@ -27,7 +27,9 @@
;;; Code:
(defcustom ledger-init-file-name "~/.ledgerrc"
"Location of the ledger initialization file. nil if you don't have one."
"Location of the ledger initialization file.
nil if you don't have one or don't wish to read it."
:type '(choice (const :tag "Do not read ledger initialization file" nil)
file)
:group 'ledger-exec)
lisp/ledger-mode/ledger-mode-pkg.el
+3 -3
View File
@@ -1,7 +1,7 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ledger-mode" "20251219.2350"
(define-package "ledger-mode" "20260609.609"
"Helper code for use with the \"ledger\" command-line tool."
'((emacs "26.1"))
:url "https://github.com/ledger/ledger-mode"
:commit "40e6a167530e21968e3ce7b8cb74e7595cb6009a"
:revdesc "40e6a167530e")
:commit "b0ee99feb2dcae5e304ad735d82d488f2191a51c"
:revdesc "b0ee99feb2dc")
lisp/ledger-mode/ledger-mode.el
+13 -12
View File
@@ -4,9 +4,10 @@
;; This file is not part of GNU Emacs.
;; Package-Version: 20251219.2350
;; Package-Revision: 40e6a167530e
;; Package-Version: 20260609.609
;; Package-Revision: b0ee99feb2dc
;; Package-Requires: ((emacs "26.1"))
;; URL: https://github.com/ledger/ledger-mode
;; This 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
@@ -70,7 +71,7 @@
(defun ledger-mode-dump-variable (var)
"Format VAR for dump to buffer."
(if var
(insert (format " %s: %S\n" (symbol-name var) (eval var)))))
(insert (format " %s: %S\n" (symbol-name var) (symbol-value var)))))
(defun ledger-mode-dump-group (group)
"Dump GROUP customizations to current buffer."
@@ -156,12 +157,10 @@ the balance into that."
(ledger-exec-ledger buffer (current-buffer) "stats")
(buffer-substring-no-properties (point-min) (1- (point-max))))))
(when balance
(message balance))))
(message "%s" balance))))
(defvar ledger-mode-abbrev-table)
(defvar ledger-date-string-today (ledger-format-date))
;;; Editing commands
@@ -386,7 +385,9 @@ With prefix ARG, decrement by that many instead."
(define-key map (kbd "C-c C-o C-a") #'ledger-report-redo)
(define-key map (kbd "C-c C-o C-e") #'ledger-report-edit-report)
(define-key map (kbd "C-c C-o C-g") #'ledger-report-goto)
;; `C-g' is reserved as the universal quit key, so use `C-v' (visit) for
;; ledger-report-goto instead.
(define-key map (kbd "C-c C-o C-v") #'ledger-report-goto)
(define-key map (kbd "C-c C-o C-k") #'ledger-report-quit)
(define-key map (kbd "C-c C-o C-r") #'ledger-report)
(define-key map (kbd "C-c C-o C-s") #'ledger-report-save)
@@ -399,7 +400,7 @@ With prefix ARG, decrement by that many instead."
(define-key map (kbd "S-<down>") #'ledger-date-down)
;; Reset the `text-mode' override of this standard binding
(define-key map (kbd "C-M-i") 'completion-at-point)
(define-key map (kbd "C-M-i") #'completion-at-point)
map)
"Keymap for `ledger-mode'.")
@@ -447,11 +448,11 @@ With prefix ARG, decrement by that many instead."
(define-derived-mode ledger-mode text-mode "Ledger"
"A mode for editing ledger data files."
(ledger-check-version)
(setq font-lock-defaults
'(ledger-font-lock-keywords t nil nil nil))
(add-hook 'font-lock-extend-region-functions 'ledger-fontify-extend-region)
(setq-local font-lock-defaults
'(ledger-font-lock-keywords t nil nil nil))
(add-hook 'font-lock-extend-region-functions #'ledger-fontify-extend-region nil t)
(add-hook 'completion-at-point-functions #'ledger-complete-at-point nil t)
(add-hook 'after-save-hook 'ledger-report-redo nil t)
(add-hook 'after-save-hook 'ledger-report-redo-after-save nil t)
(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
(add-hook 'before-revert-hook 'ledger-highlight--before-revert nil t)
lisp/ledger-mode/ledger-occur.el
+15 -13
View File
@@ -153,25 +153,27 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
(when-let* ((endpoint (re-search-forward regex nil 'end))
(bounds (ledger-navigate-find-element-extents endpoint)))
(push bounds lines)
;; move to the end of the xact, no need to search inside it more
(goto-char (cadr bounds))))
;; Move to the end of the xact, no need to search inside it more.
;; Defensive: if extent end is at or before point, advance past the
;; match end so the loop can never wedge.
(goto-char (max (cadr bounds) (1+ (match-end 0))))))
(nreverse lines))))
(defun ledger-occur-compress-matches (buffer-matches)
"Identify sequential xacts to reduce number of overlays required.
BUFFER-MATCHES should be a list of (BEG END) lists."
(if buffer-matches
(let ((points (list))
(current-beginning (caar buffer-matches))
(current-end (cl-cadar buffer-matches)))
(dolist (match (cdr buffer-matches))
(if (< (- (car match) current-end) 2)
(setq current-end (cadr match))
(push (list current-beginning current-end) points)
(setq current-beginning (car match))
(setq current-end (cadr match))))
(nreverse (push (list current-beginning current-end) points)))))
(when buffer-matches
(let ((points (list))
(current-beginning (caar buffer-matches))
(current-end (cl-cadar buffer-matches)))
(dolist (match (cdr buffer-matches))
(if (< (- (car match) current-end) 2)
(setq current-end (cadr match))
(push (list current-beginning current-end) points)
(setq current-beginning (car match))
(setq current-end (cadr match))))
(nreverse (push (list current-beginning current-end) points)))))
(provide 'ledger-occur)
lisp/ledger-mode/ledger-reconcile.el
+4 -2
View File
@@ -156,8 +156,10 @@ described above."
:type 'boolean
:group 'ledger-reconcile)
(defvar-local ledger-reconcile-last-balance-message nil)
(defvar-local ledger-reconcile-last-balance-equals-target nil)
(defvar-local ledger-reconcile-last-balance-message nil
"Most recent cleared/pending balance line, displayed in the reconcile header.")
(defvar-local ledger-reconcile-last-balance-equals-target nil
"Non-nil when the most recent balance equals the reconciliation target.")
(defface ledger-reconcile-last-balance-equals-target-face
'((t :inherit (header-line success)))
lisp/ledger-mode/ledger-regex.el
+1 -7
View File
@@ -40,7 +40,7 @@
"\\(^[~=A-Za-z].+\\)+")
(defconst ledger-comment-regex
"^[;#|\\*%].*\\|[ \t]+;.*")
"^[;#|*%].*\\|[ \t]+;.*")
(defconst ledger-multiline-comment-start-regex
"^!comment$")
@@ -87,12 +87,6 @@
(defconst ledger-account-name-or-directive-regex
(format "\\(?:%s\\|%s\\)" ledger-account-any-status-regex ledger-account-directive-regex))
(defconst ledger-account-pending-regex
(concat "\\(^[ \t]+\\)!" ledger-account-name-maybe-virtual-regex))
(defconst ledger-account-cleared-regex
(concat "\\(^[ \t]+\\)*" ledger-account-name-maybe-virtual-regex))
(defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions."
(let* ((regex (eval regex))
lisp/ledger-mode/ledger-report.el
+84 -42
View File
@@ -1,4 +1,4 @@
;; ledger-report.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*-
;;; ledger-report.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org)
@@ -32,6 +32,7 @@
(declare-function ledger-read-string-with-default "ledger-mode" (prompt default))
(declare-function ledger-read-account-with-prompt "ledger-mode" (prompt))
(declare-function ledger-read-payee-with-prompt "ledger-mode" (prompt))
(declare-function ledger-read-date "ledger-mode" (prompt))
(require 'easymenu)
(require 'ansi-color)
@@ -70,6 +71,8 @@ specifier."
("payee" . ledger-report-payee-format-specifier)
("account" . ledger-report-account-format-specifier)
("month" . ledger-report-month-format-specifier)
("amount" . ledger-report-amount-format-specifier)
("date" . ledger-report-date-format-specifier)
("tagname" . ledger-report-tagname-format-specifier)
("tagvalue" . ledger-report-tagvalue-format-specifier))
"An alist mapping ledger report format specifiers to implementing functions.
@@ -162,7 +165,12 @@ Calls `shrink-window-if-larger-than-buffer'."
(defvar ledger-report-buffer-name "*Ledger Report*")
(defvar-local ledger-report-name nil)
(defvar-local ledger-report-cmd nil)
(defvar-local ledger-report-cmd nil
"The raw command template for the current ledger report buffer.
Format specifiers such as %(binary) and %(ledger-file) are left
unexpanded and resolved at execution time in `ledger-do-report',
so the current values of `ledger-binary-path' and the ledger file
take effect on each run.")
(defvar-local ledger-report-saved nil)
(defvar-local ledger-report-current-month nil)
(defvar-local ledger-report-is-reversed nil)
@@ -193,10 +201,11 @@ See documentation for the function `ledger-master-file'")
(save-excursion
(reverse-region (point) (point-max)))))
(defun ledger-report-maybe-shrink-window ()
"Shrink window if `ledger-report-resize-window' is non-nil."
(defun ledger-report-maybe-shrink-window (buf)
"Shrink window displaying BUF if `ledger-report-resize-window' is non-nil."
(when ledger-report-resize-window
(shrink-window-if-larger-than-buffer)))
(when-let* ((w (get-buffer-window buf)))
(shrink-window-if-larger-than-buffer w))))
(defvar ledger-report-mode-map
(let ((map (make-sparse-keymap)))
@@ -237,7 +246,7 @@ See documentation for the function `ledger-master-file'")
(define-derived-mode ledger-report-mode special-mode "Ledger-Report"
"A mode for viewing ledger reports."
(setq-local revert-buffer-function #'ledger-report-redo)
(setq-local revert-buffer-function #'ledger-report--revert-buffer)
(hack-dir-local-variables-non-file-buffer))
(defconst ledger-report--extra-args-marker "[[ledger-mode-flags]]")
@@ -259,6 +268,14 @@ See documentation for the function `ledger-master-file'")
;; values, but it remains to be implemented.
(ledger-read-string-with-default "Tag Value" nil))
(defun ledger-report-amount-format-specifier ()
"Return a commoditized amount."
(ledger-commodity-to-string (ledger-read-commodity-string "Amount")))
(defun ledger-report-date-format-specifier ()
"Return a date."
(ledger-read-date "Date: "))
(defun ledger-report-read-name ()
"Read the name of a ledger report to use, with completion.
@@ -305,7 +322,7 @@ used to generate the buffer, navigating the buffer, etc."
(with-silent-modifications
(erase-buffer)
(ledger-do-report ledger-report-cmd))
(ledger-report-maybe-shrink-window)
(ledger-report-maybe-shrink-window (current-buffer))
(run-hooks 'ledger-report-after-report-hook)
(message (substitute-command-keys (concat "\\[ledger-report-quit] to quit; "
"\\[ledger-report-redo] to redo; "
@@ -339,7 +356,7 @@ returns nil."
(defun ledger-report-read-command (report-cmd)
"Read the command line to create a report from REPORT-CMD."
(read-from-minibuffer "Report command line: "
(if (null report-cmd) "ledger " report-cmd)
(if (null report-cmd) "%(binary) " report-cmd)
nil nil 'ledger-report-cmd-prompt-history))
(defun ledger-report-ledger-file-format-specifier ()
@@ -416,7 +433,7 @@ MONTH is of the form (YEAR . INDEX) where INDEX ranges from
(defun ledger-report-month-format-specifier ()
"Substitute current month."
(with-current-buffer (or ledger-report-buffer-name (current-buffer))
(with-current-buffer ledger-report-buffer-name
(let* ((month (or ledger-report-current-month (ledger-report--current-month)))
(year (car month))
(month-index (cdr month)))
@@ -427,7 +444,9 @@ MONTH is of the form (YEAR . INDEX) where INDEX ranges from
Format specifiers are defined in the
`ledger-report-format-specifiers' alist. The functions are
called in the ledger buffer for which the report is being run."
called in the ledger buffer for which the report is being run.
This function must be called from a report buffer."
(let ((ledger-buf ledger-report-ledger-buf))
(with-temp-buffer
(save-excursion (insert report-cmd))
@@ -465,13 +484,19 @@ called in the ledger buffer for which the report is being run."
(defun ledger-report-cmd (report-name edit)
"Get the command line to run the report name REPORT-NAME.
Optionally EDIT the command."
Optionally EDIT the command.
The returned command retains its format specifiers (e.g., %(binary)
and %(ledger-file)) so that `ledger-do-report' can expand them each
time the report runs. This keeps saved reports in `ledger-reports'
responsive to later changes in `ledger-binary-path' or the current
ledger file, rather than baking in the values observed when the
report was first run."
(let ((report-cmd (car (cdr (assoc report-name ledger-reports)))))
;; logic for substitution goes here
(when (or (null report-cmd) edit)
(setq report-cmd (ledger-report-read-command report-cmd))
(setq ledger-report-saved nil)) ;; this is a new report, or edited report
(setq report-cmd (ledger-report-expand-format-specifiers report-cmd))
(setq ledger-report-cmd report-cmd)
(or (string-empty-p report-name)
(ledger-report-name-exists report-name)
@@ -491,7 +516,7 @@ Optionally EDIT the command."
(previous-month (ledger-report--shift-month current-month shift)))
(setq ledger-report-current-month previous-month)
(ledger-report-cmd ledger-report-name nil)
(ledger-report-redo)))
(revert-buffer)))
(defun ledger-report--add-links ()
"Replace file and line annotations with buttons."
@@ -518,16 +543,19 @@ Optionally EDIT the command."
(defun ledger-do-report (cmd)
"Run a report command line CMD.
CMD may contain a (shell-quoted) version of
`ledger-report--extra-args-marker', which will be replaced by
arguments returned by `ledger-report--compute-extra-args'."
CMD may contain format specifiers (e.g., %(binary), %(ledger-file))
which are expanded via `ledger-report-expand-format-specifiers'
each time the report runs. It may also contain a (shell-quoted)
version of `ledger-report--extra-args-marker', which will be
replaced by arguments returned by `ledger-report--compute-extra-args'."
(goto-char (point-min))
(let* ((marker ledger-report--extra-args-marker)
(let* ((expanded-cmd (ledger-report-expand-format-specifiers cmd))
(marker ledger-report--extra-args-marker)
(marker-re (concat " *" (regexp-quote marker)))
(args (ledger-report--compute-extra-args cmd))
(args (ledger-report--compute-extra-args expanded-cmd))
(args-str (concat " " (mapconcat #'shell-quote-argument args " ")))
(clean-cmd (replace-regexp-in-string marker-re "" cmd t t))
(real-cmd (replace-regexp-in-string marker-re args-str cmd t t)))
(clean-cmd (replace-regexp-in-string marker-re "" expanded-cmd t t))
(real-cmd (replace-regexp-in-string marker-re args-str expanded-cmd t t)))
(setq header-line-format
(and ledger-report-use-header-line
`(:eval (ledger-report--compute-header-line ,clean-cmd))))
@@ -541,7 +569,7 @@ arguments returned by `ledger-report--compute-extra-args'."
(setq report (ansi-color-apply report)))
(save-excursion
(insert report))
(when (ledger-report--cmd-needs-links-p cmd)
(when (ledger-report--cmd-needs-links-p expanded-cmd)
(save-excursion
(ledger-report--add-links))))))
@@ -571,31 +599,42 @@ specific posting at point instead."
(if (not rbuf)
(error "There is no ledger report buffer"))
(pop-to-buffer rbuf)
(ledger-report-maybe-shrink-window)))
(ledger-report-maybe-shrink-window rbuf)))
(defun ledger-report-redo (&optional _ignore-auto _noconfirm)
"Redo the report in the current ledger report buffer.
(defun ledger-report-redo-after-save ()
"If `ledger-report-auto-refresh' is non-nil, redo the report buffer.
This is intended to be added to `after-save-hook' by `ledger-mode'."
(when (and ledger-report-auto-refresh
(get-buffer ledger-report-buffer-name))
(with-current-buffer ledger-report-buffer-name
(revert-buffer))))
(defun ledger-report--revert-buffer (&optional _ignore-auto _noconfirm)
"Redo the report in the current buffer.
IGNORE-AUTO and NOCONFIRM are for compatibility with
`revert-buffer-function' and are currently ignored."
(when (buffer-live-p ledger-report-ledger-buf)
(setq ledger-report-cursor-line-number (line-number-at-pos))
(with-silent-modifications
(erase-buffer)
(ledger-do-report ledger-report-cmd)
(when ledger-report-is-reversed
(ledger-report-reverse-lines))
(when ledger-report-auto-refresh-sticky-cursor
(forward-line (- ledger-report-cursor-line-number 5))))
(ledger-report-maybe-shrink-window (current-buffer))
(run-hooks 'ledger-report-after-report-hook)))
(defun ledger-report-redo ()
"Redo the report in the ledger report buffer."
(interactive)
(unless (or (derived-mode-p 'ledger-mode)
(derived-mode-p 'ledger-report-mode))
(user-error "Not in a ledger-mode or ledger-report-mode buffer"))
(let ((cur-buf (current-buffer)))
(when (and ledger-report-auto-refresh
(get-buffer ledger-report-buffer-name))
(pop-to-buffer (get-buffer ledger-report-buffer-name))
(ledger-report-maybe-shrink-window)
(setq ledger-report-cursor-line-number (line-number-at-pos))
(with-silent-modifications
(erase-buffer)
(ledger-do-report ledger-report-cmd)
(when ledger-report-is-reversed
(ledger-report-reverse-lines))
(when ledger-report-auto-refresh-sticky-cursor
(forward-line (- ledger-report-cursor-line-number 5))))
(run-hooks 'ledger-report-after-report-hook)
(pop-to-buffer cur-buf))))
(when (get-buffer ledger-report-buffer-name)
(with-current-buffer ledger-report-buffer-name
(revert-buffer))))
(defun ledger-report-quit ()
"Quit the ledger report buffer and kill its buffer."
@@ -614,8 +653,11 @@ IGNORE-AUTO and NOCONFIRM are for compatibility with
(defun ledger-report-edit-report ()
"Edit the current report command in the mini buffer and re-run the report."
(interactive)
(setq ledger-report-cmd (ledger-report-read-command ledger-report-cmd))
(ledger-report-redo))
(unless (derived-mode-p 'ledger-report-mode)
(user-error "Not a ledger report buffer"))
(with-current-buffer ledger-report-buffer-name
(setq ledger-report-cmd (ledger-report-read-command ledger-report-cmd))
(revert-buffer)))
(define-obsolete-function-alias 'ledger-report-select-report #'ledger-report "ledger 4.0.0")
@@ -673,7 +715,7 @@ IGNORE-AUTO and NOCONFIRM are for compatibility with
(setq ledger-report-cmd (replace-match "" nil nil ledger-report-cmd))
(setq ledger-report-cmd (concat ledger-report-cmd
" --exchange " ledger-reconcile-default-commodity))))
(ledger-report-redo))
(revert-buffer))
(provide 'ledger-report)
lisp/ledger-mode/ledger-schedule.el
+2 -7
View File
@@ -74,11 +74,6 @@ abbreviation for a day and the number of that day in the week."
:type '(alist :key-type string :value-type (group integer))
:group 'ledger-schedule)
(defsubst ledger-between (val low high)
"Return TRUE if VAL >= LOW and <= HIGH."
(declare (obsolete <= "Ledger-mode v4.0.1"))
(<= low val high))
(defun ledger-schedule-days-in-month (month year)
"Return number of days in the MONTH, MONTH is from 1 to 12.
If YEAR is nil, assume it is not a leap year"
@@ -142,8 +137,8 @@ The dates are given by the pairs MONTH1 DAY1 and MONTH2 DAY2."
(target-month (gensym))
(target-day (gensym)))
`(let* ((,decoded (decode-time date))
(,target-month (nth 4 decoded))
(,target-day (nth 3 decoded)))
(,target-month (nth 4 ,decoded))
(,target-day (nth 3 ,decoded)))
(and (and (> ,target-month ,month1)
(< ,target-month ,month2))
(and (> ,target-day ,day1)
lisp/llama/llama-pkg.el
+7 -5
View File
@@ -1,9 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "llama" "20260301.1253"
(define-package "llama" "20260601.1455"
"Compact syntax for short lambda."
'((emacs "26.1")
(compat "30.1"))
(compat "31.0"))
:url "https://github.com/tarsius/llama"
:commit "d430d48e0b5afd2a34b5531f103dcb110c3539c4"
:revdesc "d430d48e0b5a"
:keywords '("extensions"))
:commit "4d4024048053b898a01521046e0f063ee47615b0"
:revdesc "4d4024048053"
:keywords '("extensions")
:authors '(("Jonas Bernoulli" . "emacs.llama@jonas.bernoulli.dev"))
:maintainers '(("Jonas Bernoulli" . "emacs.llama@jonas.bernoulli.dev")))
lisp/llama/llama.el
+6 -6
View File
@@ -2,15 +2,15 @@
;; Copyright (C) 2020-2026 Jonas Bernoulli
;; Authors: Jonas Bernoulli <emacs.llama@jonas.bernoulli.dev>
;; Author: Jonas Bernoulli <emacs.llama@jonas.bernoulli.dev>
;; Homepage: https://github.com/tarsius/llama
;; Keywords: extensions
;; Package-Version: 20260301.1253
;; Package-Revision: d430d48e0b5a
;; Package-Version: 20260601.1455
;; Package-Revision: 4d4024048053
;; Package-Requires: (
;; (emacs "26.1")
;; (compat "30.1"))
;; (compat "31.0"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -362,7 +362,7 @@ expansion, and the looks of this face should hint at that.")
(put-text-property (match-beginning 0) (point)
'font-lock-multiline t)
(llama--fontify (cdr expr) nil nil t)))))
(list re end))) ; Silence compiler.
(progn re end nil))) ; Silence compiler.
(defun llama--fontify (expr &optional fnpos backquoted top)
(static-if (fboundp 'bare-symbol)
@@ -419,7 +419,7 @@ expansion, and the looks of this face should hint at that.")
(throw t nil))))
(when expr
(llama--fontify expr fnpos))))))
(list expr fnpos backquoted top)) ; Silence compiler.
(and expr fnpos backquoted top nil)) ; Silence compiler.
(defvar llama-fontify-mode-lighter nil)
lisp/magit-section/magit-section-pkg.el
+4 -4
View File
@@ -1,14 +1,14 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "magit-section" "20260330.1102"
(define-package "magit-section" "20260514.937"
"Sections for read-only buffers."
'((emacs "28.1")
(compat "30.1")
(compat "31.0")
(cond-let "0.2")
(llama "1.0")
(seq "2.24"))
:url "https://github.com/magit/magit"
:commit "89a51310bd8f8087c44f7ac5c902cc82dddbbe2a"
:revdesc "89a51310bd8f"
:commit "be5a3b0e9f7a64bcb222ba546a18e6b09922e0a9"
:revdesc "be5a3b0e9f7a"
:keywords '("tools")
:authors '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev"))
:maintainers '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")))
lisp/magit-section/magit-section.el
+43 -25
View File
@@ -8,11 +8,11 @@
;; Homepage: https://github.com/magit/magit
;; Keywords: tools
;; Package-Version: 20260330.1102
;; Package-Revision: 89a51310bd8f
;; Package-Version: 20260514.937
;; Package-Revision: be5a3b0e9f7a
;; Package-Requires: (
;; (emacs "28.1")
;; (compat "30.1")
;; (compat "31.0")
;; (cond-let "0.2")
;; (llama "1.0")
;; (seq "2.24"))
@@ -51,15 +51,10 @@
(require 'llama) ; For (##these ...) see M-x describe-function RET # # RET.
(require 'subr-x)
;; For older Emacs releases we depend on an updated `seq' release from GNU
;; ELPA, for `seq-keep'. Unfortunately something else may require `seq'
;; before `package' had a chance to put this version on the `load-path'.
(when (and (featurep 'seq)
(not (fboundp 'seq-keep)))
(unload-feature 'seq 'force))
(require 'seq)
;; Furthermore, by default `package' just silently refuses to upgrade.
(defconst magit--core-upgrade-instructions "\
(defun magit--display-core-upgrade-instructions (package version)
(display-warning 'magit
(substitute-command-keys
(format "\
Magit requires `%s' >= %s,
but due to bad defaults, Emacs' package manager, refuses to
upgrade this and other built-in packages to higher releases
@@ -87,13 +82,29 @@ reinstalling Magit.
If you don't use the `package' package manager but still get
this warning, then your chosen package manager likely has a
similar defect.")
(unless (fboundp 'seq-keep)
(display-warning 'magit (substitute-command-keys
(format magit--core-upgrade-instructions
'seq "2.24" 'seq 'seq 'seq 'seq))
similar defect."
package version package package package package))
:emergency))
;; For older Emacs releases we depend on an updated `seq' release from GNU
;; ELPA, for `seq-keep'. Unfortunately something else may require `seq'
;; before `package' had a chance to put this version on the `load-path'.
(when (and (featurep 'seq)
(not (fboundp 'seq-keep)))
(unload-feature 'seq 'force))
(require 'seq)
;; Furthermore, by default `package' just silently refuses to upgrade.
(unless (fboundp 'seq-keep)
(magit--display-core-upgrade-instructions 'seq "2.24"))
;; Likewise, we require a recent `transient'.
(when (and (featurep 'transient)
(not (fboundp 'transient--advise-this-command)))
(unload-feature 'transient 'force))
(require 'transient)
(unless (fboundp 'transient--advise-this-command)
(magit--display-core-upgrade-instructions 'transient "0.13"))
(require 'cursor-sensor)
(require 'format-spec)
@@ -116,6 +127,9 @@ similar defect.")
That function in turn is used by all section movement commands.
See also info node `(magit)Section Movement'.")
(defvar magit-mouse-set-point-hook nil
"Hook run by `magit-mouse-set-point-hook'.")
(defvar magit-section-set-visibility-hook
(list #'magit-section-cached-visibility)
"Hook used to set the initial visibility of a section.
@@ -878,10 +892,10 @@ If there is no previous sibling section, then move to the parent."
((magit-section-backward))))
(defun magit-mouse-set-point (event &optional promote-to-region)
"Like `mouse-set-point' but also call `magit-section-movement-hook'."
"Like `mouse-set-point' but also call `magit-mouse-set-point-hook'."
(interactive "e\np")
(mouse-set-point event promote-to-region)
(run-hook-with-args 'magit-section-movement-hook (magit-current-section)))
(run-hook-with-args 'magit-mouse-set-point-hook (magit-current-section)))
(defun magit-section-goto (arg)
"Run `magit-section-movement-hook'.
@@ -1105,7 +1119,7 @@ sections."
(cl-do* ((s section
(oref s parent))
(i (1- (length (magit-section-ident s)))
(cl-decf i)))
(decf i)))
((cond ((< i level) (magit-section-show-children s (- level i 1)) t)
((= i level) (magit-section-hide s) t))
(magit-section-goto s))))))
@@ -2239,8 +2253,8 @@ forms CONDITION can take."
(setq siblings nil)))
(setq sections (nreverse sections))
(and (or (not condition)
(seq-every-p (##magit-section-match condition %)
sections))
(all (##magit-section-match condition %)
sections))
sections))))))))
(defun magit-map-sections (function &optional section)
@@ -2675,11 +2689,15 @@ with the variables' values as arguments, which were recorded by
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("thread$" . "cond-let--thread$")
;; ("when$" . "cond-let--when$")
;; ("and-let*" . "cond-let--and-let*")
;; ("and-let" . "cond-let--and-let")
;; ("if-let*" . "cond-let--if-let*")
;; ("if-let" . "cond-let--if-let")
;; ("when-let*" . "cond-let--when-let*")
;; ("when-let" . "cond-let--when-let")
;; ("while-let*" . "cond-let--while-let*")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
lisp/magit/.dir-locals.el
+4 -1
View File
@@ -2,7 +2,10 @@
(indent-tabs-mode . nil))
(emacs-lisp-mode
(checkdoc-allow-quoting-nil-and-t . t)
(lisp-indent-local-overrides . ((cond . 0) (interactive . 0))))
(lisp-indent-local-overrides
. ((cond . 0)
(interactive . 0)
(make-obsolete-variable . 1))))
(makefile-mode
(indent-tabs-mode . t)
(mode . outline-minor)
lisp/magit/AUTHORS.md
+4
View File
@@ -87,6 +87,7 @@ All Contributors
- Bryan Shell
- Buster Copley
- Cameron Chaparro
- Carl Lei
- Carl Lieberman
- Chillar Anand
- Chris Bernard
@@ -195,6 +196,7 @@ All Contributors
- Johannes Altmanninger
- Johannes Maier
- Johann Klähn
- John Eismeier
- John Mastro
- John Morris
- John Wiegley
@@ -305,6 +307,7 @@ All Contributors
- Paul Pogonyshev
- Paul Stadig
- Pavel Holejsovsky
- Pedro Ribeiro Mendes Júnior
- Pekka Pessi
- Pengji Zhang
- Peter Eisentraut
@@ -386,6 +389,7 @@ All Contributors
- Teruki Shigitani
- Thierry Volpiatto
- Thomas A Caswell
- Thomas Ferrand
- Thomas Fini Hansen
- Thomas Frössman
- Thomas Jost
lisp/magit/git-commit.el
+48 -28
View File
@@ -247,7 +247,7 @@ See also manpage git-interpret-trailer(1). This package does
not use that Git command, but the initial description still
serves as a good introduction."
:group 'git-commit
:safe (##and (listp %) (seq-every-p #'stringp %))
:safe (##and (listp %) (all #'stringp %))
:type '(repeat string))
(defcustom git-commit-use-local-message-ring nil
@@ -760,7 +760,7 @@ With a numeric prefix ARG, go back ARG messages."
(when-let* ((message (git-commit-buffer-message))
(_(not (ring-member log-edit-comment-ring message))))
(ring-insert log-edit-comment-ring message)
(cl-incf arg)
(incf arg)
(setq len (ring-length log-edit-comment-ring)))
;; Delete the message but not the instructions at the end.
(save-restriction
@@ -1020,32 +1020,48 @@ completion candidates. The input must have the form \"NAME <EMAIL>\"."
(git-commit--insert-trailer trailer (format "%s <%s>" name email)))
(defun git-commit--insert-trailer (trailer value)
(git-commit--insert-trailer-1 (format "%s: %s\n" trailer value)))
(defun git-commit--insert-trailer-1 (string &optional before-trailers)
(save-excursion
(let ((string (format "%s: %s" trailer value))
(leading-comment-end nil))
;; Make sure we skip forward past any leading comments.
(goto-char (point-min))
(while (looking-at comment-start)
(forward-line))
(when (or (eobp) (looking-at "diff --git"))
(goto-char (point-min))
(while (looking-at comment-start)
(forward-line))
(setq leading-comment-end (point))
(save-excursion (insert ?\n)))
(let ((bound (and (not (or (bobp) (eobp))) (point))))
(goto-char (point-max))
(cond
;; Look backwards for existing trailers.
((re-search-backward (git-commit--trailer-regexp) nil t)
(end-of-line)
(insert ?\n string)
(unless (= (char-after) ?\n)
(insert ?\n)))
;; Or place the new trailer right before the first non-leading
;; comments.
(t
(while (re-search-backward (concat "^" comment-start)
leading-comment-end t))
(unless (looking-back "\n\n" nil)
(insert ?\n))
(insert string ?\n))))
(unless (or (eobp) (= (char-after) ?\n))
(insert ?\n))))
(unless (or (bobp) (= (char-before) ?\n))
(insert ?\n))
(cond (before-trailers
(git-commit--goto-insert-position bound)
(while (re-search-backward (git-commit--trailer-regexp) nil t))
(unless (looking-back "\n\n" nil)
(insert ?\n)))
((re-search-backward (git-commit--trailer-regexp) nil t)
(goto-char (match-end 0))
(if (eobp) (insert ?\n) (forward-char)))
(t
(git-commit--goto-insert-position bound)
(unless (looking-back "\n\n" nil)
(insert ?\n)))))
(insert string)
(unless (ignore-errors (= (char-before) ?\n)) (insert ?\n))
(unless (ignore-errors (= (char-after) ?\n)) (insert ?\n))))
(defun git-commit--goto-insert-position (bound)
(let ((match (point)))
(cond ((re-search-backward (format "^%s -+ >8 -+" comment-start) nil t))
((and (eobp) (bolp))
(forward-line -1)))
(while (and (or (looking-at comment-start)
(looking-at "[\s\t]*$"))
(or (not bound) (> (point) bound))
(not (bobp)))
(setq match (point))
(forward-line -1))
(goto-char match)))
;;; Font-Lock
@@ -1357,11 +1373,15 @@ commit, then the hook is not run at all."
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("thread$" . "cond-let--thread$")
;; ("when$" . "cond-let--when$")
;; ("and-let*" . "cond-let--and-let*")
;; ("and-let" . "cond-let--and-let")
;; ("if-let*" . "cond-let--if-let*")
;; ("if-let" . "cond-let--if-let")
;; ("when-let*" . "cond-let--when-let*")
;; ("when-let" . "cond-let--when-let")
;; ("while-let*" . "cond-let--while-let*")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
lisp/magit/git-hooks/applypatch-msg
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/commit-msg
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/fallthrough
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/fsmonitor-watchman
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/p4-changelist
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/p4-post-changelist
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/p4-pre-submit
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/p4-prepare-changelist
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/post-applypatch
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/post-checkout
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/post-commit
-13
View File
@@ -1,13 +0,0 @@
#!/usr/bin/env bash
if [[ "$INSIDE_EMACS" == *magit ]]
then
for arg in "$@"; do args+="\"$arg\""; done
$GIT_EDITOR --eval \
"(magit-run-git-hook '(common-post-commit post-commit) ${args[@]})"
fi
if [[ -x "$SHADOWED_GITHOOK_DIRECTORY" ]]
then
"$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)" "$@"
fi
lisp/magit/git-hooks/post-index-change
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/post-merge
-13
View File
@@ -1,13 +0,0 @@
#!/usr/bin/env bash
if [[ "$INSIDE_EMACS" == *magit ]]
then
for arg in "$@"; do args+="\"$arg\""; done
$GIT_EDITOR --eval \
"(magit-run-git-hook '(common-post-commit post-merge) ${args[@]})"
fi
if [[ -x "$SHADOWED_GITHOOK_DIRECTORY" ]]
then
"$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)" "$@"
fi
lisp/magit/git-hooks/post-receive
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/post-rewrite
-13
View File
@@ -1,13 +0,0 @@
#!/usr/bin/env bash
if [[ "$INSIDE_EMACS" == *magit ]]
then
for arg in "$@"; do args+="\"$arg\""; done
$GIT_EDITOR --eval \
"(magit-run-git-hook '(common-post-commit post-rewrite) ${args[@]})"
fi
if [[ -x "$SHADOWED_GITHOOK_DIRECTORY" ]]
then
"$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)" "$@"
fi
lisp/magit/git-hooks/post-update
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-applypatch
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-auto-gc
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-commit
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-merge-commit
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-push
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-rebase
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi
lisp/magit/git-hooks/pre-receive
-8
View File
@@ -1,8 +0,0 @@
#!/usr/bin/env bash
hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
if [[ -x "$hook" ]]
then
"$hook" "$@"
fi

Some files were not shown because too many files have changed in this diff Show More