1.1--- a/emacs/default.el Sun Nov 26 16:43:15 2023 -0500
1.2+++ b/emacs/default.el Sun Nov 26 22:11:45 2023 -0500
1.3@@ -1,7 +1,6 @@
1.4 ;;; default.el --- default config -*- lexical-binding: t -*-
1.5
1.6 ;;; Code:
1.7-
1.8 ;;; Settings
1.9 (put 'upcase-region 'disabled nil)
1.10 (put 'list-threads 'disabled nil)
1.11@@ -124,19 +123,20 @@
1.12 ;; used by `completion-at-point'. The order of the functions matters, the
1.13 ;; first function returning a result wins. Note that the list of buffer-local
1.14 ;; completion functions takes precedence over the global list.
1.15+ (add-to-list 'completion-at-point-functions #'cape-dabbrev)
1.16 (add-to-list 'completion-at-point-functions #'cape-abbrev)
1.17- (add-to-list 'completion-at-point-functions #'cape-dabbrev)
1.18- (add-to-list 'completion-at-point-functions #'cape-history)
1.19+ ;; (add-to-list 'completion-at-point-functions #'cape-history)
1.20 (add-to-list 'completion-at-point-functions #'cape-keyword)
1.21 (add-to-list 'completion-at-point-functions #'cape-file)
1.22- (add-to-list 'completion-at-point-functions #'cape-line)
1.23- (add-to-list 'completion-at-point-functions #'cape-elisp-block)
1.24+ ;; (add-to-list 'completion-at-point-functions #'cape-line)
1.25+ ;; (add-to-list 'completion-at-point-functions #'cape-elisp-block)
1.26 (add-to-list 'completion-at-point-functions #'cape-tex)
1.27- (add-to-list 'completion-at-point-functions #'cape-sgml)
1.28- (add-to-list 'completion-at-point-functions #'cape-rfc1345)
1.29- (add-to-list 'completion-at-point-functions #'cape-dict)
1.30- (add-to-list 'completion-at-point-functions #'cape-elisp-symbol)
1.31- (add-to-list 'completion-at-point-functions #'cape-emoji))
1.32+ ;; (add-to-list 'completion-at-point-functions #'cape-sgml)
1.33+ ;; (add-to-list 'completion-at-point-functions #'cape-rfc1345)
1.34+ ;; (add-to-list 'completion-at-point-functions #'cape-dict)
1.35+ ;; (add-to-list 'completion-at-point-functions #'cape-elisp-symbol)
1.36+ ;; (add-to-list 'completion-at-point-functions #'cape-emoji)
1.37+ )
1.38
1.39 (use-package orderless
1.40 :custom
2.1--- a/emacs/ellis.el Sun Nov 26 16:43:15 2023 -0500
2.2+++ b/emacs/ellis.el Sun Nov 26 22:11:45 2023 -0500
2.3@@ -25,13 +25,19 @@
2.4 ;;; Code:
2.5 (require 'inbox)
2.6 (require 'sk)
2.7-(require 'slime-cape)
2.8+;; (require 'slime-cape)
2.9 (require 'sxp)
2.10-(setopt default-theme 'modus-vivendi-tinted
2.11- company-source-directory (join-paths user-home-directory "dev/comp"))
2.12+(require 'ulang)
2.13+
2.14+(defalias 'make #'compile)
2.15+
2.16+(setopt default-theme 'modus-vivendi-tritanopia
2.17+ user-lab-directory (join-paths user-home-directory "dev")
2.18+ company-source-directory (join-paths user-lab-directory "comp"))
2.19
2.20 (defvar emacs-config-source (join-paths company-source-directory "core/emacs"))
2.21
2.22+;;;###autoload
2.23 (defun edit-emacs-config (&optional src)
2.24 (interactive (list current-prefix-arg))
2.25 (let ((file (if src
2.26@@ -41,8 +47,8 @@
2.27
2.28 (keymap-set user-map "e c" #'edit-emacs-config)
2.29
2.30-;; (add-hook 'lisp-mode-hook #'enable-paredit-mode)
2.31-;; (add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode)
2.32+(add-hook 'common-lisp-mode-hook #'enable-paredit-mode)
2.33+(add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode)
2.34
2.35 (repeat-mode)
2.36
2.37@@ -57,8 +63,8 @@
2.38
2.39 (keymap-global-set "C-<tab>" #'hippie-expand)
2.40 (keymap-set minibuffer-local-map "C-<tab>" #'hippie-expand)
2.41-(keymap-set user-map "p r" #'remember-project)
2.42-(keymap-set user-map "p s" #'remember-lab-projects)
2.43+(keymap-set ctl-x-x-map "p p" #'remember-project)
2.44+(keymap-set ctl-x-x-map "p l" #'remember-lab-projects)
2.45
2.46 (add-hook 'prog-mode-hook #'skt-mode)
2.47 (add-hook 'org-mode-hook #'skt-mode)
2.48@@ -194,7 +200,7 @@
2.49 (mapc #'elfeed-search-update-entry entries)
2.50 (unless (use-region-p) (forward-line))))
2.51 :config
2.52- (keymap-set elfeed-search-mode-map (kbd "d") 'elfeed-youtube-dl)
2.53+ (keymap-set elfeed-search-mode-map "d" 'elfeed-youtube-dl)
2.54 (keymap-set user-map "e f" #'elfeed)
2.55 (keymap-set user-map "e F" #'elfeed-update))
2.56
2.57@@ -236,11 +242,10 @@
2.58 (lilypond . t)))
2.59
2.60
2.61-(add-to-list 'slime-contribs 'slime-cape)
2.62-(add-hook 'slime-mode-hook #'company-mode)
2.63-(add-hook 'slime-repl-mode-hook #'company-mode)
2.64+;; (add-to-list 'slime-contribs 'slime-cape)
2.65+;; (add-hook 'slime-mode-hook #'company-mode)
2.66+;; (add-hook 'slime-repl-mode-hook #'company-mode)
2.67
2.68-(provide 'ellis)
2.69 ;;; Tags
2.70 ;;;###autoload
2.71 (defun refresh-tags ()
2.72@@ -248,5 +253,12 @@
2.73 (interactive)
2.74 (let ((default-directory user-emacs-directory))
2.75 (async-shell-command
2.76- "etags ./*.el ./lib/*.el ~/dev/comp/org/*.el ~/dev/comp/core/emacs/*.el ~/dev/comp/core/emacs/lib/*.el -o TAGS")))
2.77+ "etags ./*.el \\
2.78+./lib/*.el \\
2.79+~/dev/comp/org/*.el \\
2.80+~/dev/comp/core/emacs/*.el \\
2.81+~/dev/comp/core/emacs/lib/*.el \\
2.82+-o TAGS")))
2.83+
2.84+(provide 'ellis)
2.85 ;;; ellis.el ends here
3.1--- a/emacs/keys.el Sun Nov 26 16:43:15 2023 -0500
3.2+++ b/emacs/keys.el Sun Nov 26 22:11:45 2023 -0500
3.3@@ -9,10 +9,8 @@
3.4 ;; global defaults defined here.
3.5
3.6 ;;; Code:
3.7+(require 'default)
3.8
3.9-;;; User keys
3.10-;; paredit-map
3.11-(require 'default)
3.12 (defvar-keymap parens-map
3.13 :doc "parens-minor-mode keymap."
3.14 :repeat (:enter)
3.15@@ -52,9 +50,11 @@
3.16 "O" #'allout-mode
3.17 "R" #'global-auto-revert-mode
3.18 "t" #'toggle-frame-tab-bar
3.19+ "T" #'toggle-theme
3.20 "d" #'toggle-debug-on-error
3.21 "SPC" #'toggle-macro-recording
3.22- "w" #'toggle-theme)
3.23+ "s" #'slime-toggle
3.24+ "w" #'which-key-mode)
3.25
3.26 (defvar-keymap status-map
3.27 :doc "User-specified keymap for status functions. Usually bound to 'C-c c .'."
3.28@@ -117,7 +117,7 @@
3.29 "C-;" #'prog-comment-timestamp-keyword)
3.30
3.31 ;;; Modes
3.32-(add-hook
3.33+(add-hook
3.34 'conf-toml-mode-hook
3.35 (lambda ()
3.36 (keymap-set conf-toml-mode-map "C-c C-c C-r" #'rust-run)
4.1--- a/emacs/lib/make-skeleton.el Sun Nov 26 16:43:15 2023 -0500
4.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
4.3@@ -1,79 +0,0 @@
4.4-;;; make-skeleton.el --- Major mode for making skeletons -*- lexical-binding: t; -*-
4.5-
4.6-;; Copyright (C) 2023 ellis
4.7-
4.8-;; Author: ellis <ellis@rwest.io>
4.9-;; Keywords: convenience
4.10-
4.11-;; This program is free software; you can redistribute it and/or modify
4.12-;; it under the terms of the GNU General Public License as published by
4.13-;; the Free Software Foundation, either version 3 of the License, or
4.14-;; (at your option) any later version.
4.15-
4.16-;; This program is distributed in the hope that it will be useful,
4.17-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
4.18-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4.19-;; GNU General Public License for more details.
4.20-
4.21-;; You should have received a copy of the GNU General Public License
4.22-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
4.23-
4.24-;;; Commentary:
4.25-
4.26-;; Copied from http://www.panix.com/~tehom/my-code/skel-recipe.txt
4.27-
4.28-;;; Code:
4.29-(defvar make-skeleton-saved-winconf nil)
4.30-(defvar make-skeleton-header ";; make-skeleton-mode
4.31-;; (find-w3m \"http://www.panix.com/~tehom/my-code/skel-recipe.txt\")
4.32-;; (describe-function 'skeleton-insert)
4.33-;; These lines are ignored.
4.34-"
4.35- "Header string for skeleton.")
4.36-
4.37-(defun make-skeleton ()
4.38- "Create skeleton of skeleton.
4.39-It is based on `A recipe for using skeleton.el'.
4.40-http://www.panix.com/~tehom/my-code/skel-recipe.txt
4.41-
4.42-C-c C-e: Erase the skeleton contents.
4.43-C-c C-c: Finish the input."
4.44- (interactive)
4.45- (setq make-skeleton-saved-winconf (current-window-configuration))
4.46- (switch-to-buffer "*make-skeleton*")
4.47- (make-skeleton-mode)
4.48- (if (zerop (buffer-size))
4.49- (make-skeleton-erase-buffer)))
4.50-
4.51-(defun make-skeleton-finish ()
4.52- (interactive)
4.53- (set-window-configuration (or make-skeleton-saved-winconf (current-window-configuration)))
4.54- (insert "\n(define-skeleton ")
4.55- (save-excursion
4.56- (insert "_\n"
4.57- "\"Insert _\" nil\n")
4.58- (let ((lines (with-current-buffer (get-buffer-create "*make-skeleton*")
4.59- ;; skip header
4.60- (goto-char (point-min))
4.61- (re-search-forward "^[;]")
4.62- (beginning-of-line)
4.63- (split-string (buffer-substring (point) (point-max)) "\n"))))
4.64- (dolist (line lines nil)
4.65- (back-to-indentation)
4.66- (insert (format "%S > \\n\n" line))))
4.67- (insert ")\n")))
4.68-
4.69-(defun make-skeleton-erase-buffer ()
4.70- "Erase the skeleton contents."
4.71- (interactive)
4.72- (erase-buffer)
4.73- (insert make-skeleton-header))
4.74-
4.75-
4.76-(define-derived-mode make-skeleton-mode fundamental-mode "skeleton"
4.77- "Major mode for creating a skeleton of skeleton."
4.78- (define-key make-skeleton-mode-map "\C-c\C-c" 'make-skeleton-finish)
4.79- (define-key make-skeleton-mode-map "\C-c\C-e" 'make-skeleton-erase-buffer))
4.80-
4.81-(provide 'make-skeleton)
4.82-;;; make-skeleton.el ends here
5.1--- a/emacs/lib/mercurial.el Sun Nov 26 16:43:15 2023 -0500
5.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
5.3@@ -1,1286 +0,0 @@
5.4-;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
5.5-
5.6-;; Copyright (C) 2005, 2006 Bryan O'Sullivan
5.7-
5.8-;; Author: Bryan O'Sullivan <bos@serpentine.com>
5.9-
5.10-;; mercurial.el is free software; you can redistribute it and/or
5.11-;; modify it under the terms of the GNU General Public License version
5.12-;; 2 or any later version.
5.13-
5.14-;; mercurial.el is distributed in the hope that it will be useful, but
5.15-;; WITHOUT ANY WARRANTY; without even the implied warranty of
5.16-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
5.17-;; General Public License for more details.
5.18-
5.19-;; You should have received a copy of the GNU General Public License
5.20-;; along with mercurial.el, GNU Emacs, or XEmacs; see the file COPYING
5.21-;; (`C-h C-l'). If not, see <http://www.gnu.org/licenses/>.
5.22-
5.23-;;; Commentary:
5.24-
5.25-;; mercurial.el builds upon Emacs's VC mode to provide flexible
5.26-;; integration with the Mercurial distributed SCM tool.
5.27-
5.28-;; To get going as quickly as possible, load mercurial.el into Emacs and
5.29-;; type `C-c h h'; this runs hg-help-overview, which prints a helpful
5.30-;; usage overview.
5.31-
5.32-;; Much of the inspiration for mercurial.el comes from Rajesh
5.33-;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
5.34-;; job for the commercial Perforce SCM product. In fact, substantial
5.35-;; chunks of code are adapted from p4.el.
5.36-
5.37-;; This code has been developed under XEmacs 21.5, and may not work as
5.38-;; well under GNU Emacs (albeit tested under 21.4). Patches to
5.39-;; enhance the portability of this code, fix bugs, and add features
5.40-;; are most welcome.
5.41-
5.42-;; As of version 22.3, GNU Emacs's VC mode has direct support for
5.43-;; Mercurial, so this package may not prove as useful there.
5.44-
5.45-;; Please send problem reports and suggestions to bos@serpentine.com.
5.46-
5.47-
5.48-;;; Code:
5.49-(eval-when-compile (require 'cl))
5.50-(require 'diff-mode)
5.51-(require 'easymenu)
5.52-(require 'executable)
5.53-(require 'vc)
5.54-
5.55-(defmacro hg-feature-cond (&rest clauses)
5.56- "Test CLAUSES for feature at compile time.
5.57-Each clause is (FEATURE BODY...)."
5.58- (dolist (x clauses)
5.59- (let ((feature (car x))
5.60- (body (cdr x)))
5.61- (when (or (eq feature t)
5.62- (featurep feature))
5.63- (cl-return (cons 'progn body))))))
5.64-
5.65-
5.66-;;; XEmacs has view-less, while GNU Emacs has view. Joy.
5.67-
5.68-(hg-feature-cond
5.69- (xemacs (require 'view-less))
5.70- (t (require 'view)))
5.71-
5.72-
5.73-;;; Variables accessible through the custom system.
5.74-
5.75-(defgroup mercurial nil
5.76- "Mercurial distributed SCM."
5.77- :group 'tools)
5.78-
5.79-(defcustom hg-binary
5.80- (or (executable-find "hg")
5.81- (dolist (path '("~/bin/hg" "/usr/bin/hg" "/usr/local/bin/hg"))
5.82- (when (file-executable-p path)
5.83- (cl-return path))))
5.84- "The path to Mercurial's hg executable."
5.85- :type '(file :must-match t)
5.86- :group 'mercurial)
5.87-
5.88-(defcustom hg-mode-hook nil
5.89- "Hook run when a buffer enters hg-mode."
5.90- :type 'sexp
5.91- :group 'mercurial)
5.92-
5.93-(defcustom hg-commit-mode-hook nil
5.94- "Hook run when a buffer is created to prepare a commit."
5.95- :type 'sexp
5.96- :group 'mercurial)
5.97-
5.98-(defcustom hg-pre-commit-hook nil
5.99- "Hook run before a commit is performed.
5.100-If you want to prevent the commit from proceeding, raise an error."
5.101- :type 'sexp
5.102- :group 'mercurial)
5.103-
5.104-(defcustom hg-log-mode-hook nil
5.105- "Hook run after a buffer is filled with log information."
5.106- :type 'sexp
5.107- :group 'mercurial)
5.108-
5.109-(defcustom hg-global-prefix "\C-ch"
5.110- "The global prefix for Mercurial keymap bindings."
5.111- :type 'sexp
5.112- :group 'mercurial)
5.113-
5.114-(defcustom hg-commit-allow-empty-message nil
5.115- "Whether to allow changes to be committed with empty descriptions."
5.116- :type 'boolean
5.117- :group 'mercurial)
5.118-
5.119-(defcustom hg-commit-allow-empty-file-list nil
5.120- "Whether to allow changes to be committed without any modified files."
5.121- :type 'boolean
5.122- :group 'mercurial)
5.123-
5.124-(defcustom hg-rev-completion-limit 100
5.125- "The maximum number of revisions that hg-read-rev will offer to complete.
5.126-This affects memory usage and performance when prompting for revisions
5.127-in a repository with a lot of history."
5.128- :type 'integer
5.129- :group 'mercurial)
5.130-
5.131-(defcustom hg-log-limit 50
5.132- "The maximum number of revisions that hg-log will display."
5.133- :type 'integer
5.134- :group 'mercurial)
5.135-
5.136-(defcustom hg-update-modeline t
5.137- "Whether to update the modeline with the status of a file after every save.
5.138-Set this to nil on platforms with poor process management, such as Windows."
5.139- :type 'boolean
5.140- :group 'mercurial)
5.141-
5.142-(defcustom hg-incoming-repository "default"
5.143- "The repository from which changes are pulled from by default.
5.144-This should be a symbolic repository name, since it is used for all
5.145-repository-related commands."
5.146- :type 'string
5.147- :group 'mercurial)
5.148-
5.149-(defcustom hg-outgoing-repository ""
5.150- "The repository to which changes are pushed to by default.
5.151-This should be a symbolic repository name, since it is used for all
5.152-repository-related commands."
5.153- :type 'string
5.154- :group 'mercurial)
5.155-
5.156-
5.157-;;; Other variables.
5.158-
5.159-(defvar hg-mode nil
5.160- "Is this file managed by Mercurial?")
5.161-(make-variable-buffer-local 'hg-mode)
5.162-(put 'hg-mode 'permanent-local t)
5.163-
5.164-(defvar hg-status nil)
5.165-(make-variable-buffer-local 'hg-status)
5.166-(put 'hg-status 'permanent-local t)
5.167-
5.168-(defvar hg-prev-buffer nil)
5.169-(make-variable-buffer-local 'hg-prev-buffer)
5.170-(put 'hg-prev-buffer 'permanent-local t)
5.171-
5.172-(defvar hg-root nil)
5.173-(make-variable-buffer-local 'hg-root)
5.174-(put 'hg-root 'permanent-local t)
5.175-
5.176-(defvar hg-view-mode nil)
5.177-(make-variable-buffer-local 'hg-view-mode)
5.178-(put 'hg-view-mode 'permanent-local t)
5.179-
5.180-(defvar hg-view-file-name nil)
5.181-(make-variable-buffer-local 'hg-view-file-name)
5.182-(put 'hg-view-file-name 'permanent-local t)
5.183-
5.184-(defvar hg-output-buffer-name "*Hg*"
5.185- "The name to use for Mercurial output buffers.")
5.186-
5.187-(defvar hg-file-history nil)
5.188-(defvar hg-repo-history nil)
5.189-(defvar hg-rev-history nil)
5.190-(defvar hg-repo-completion-table nil) ; shut up warnings
5.191-
5.192-
5.193-;;; Random constants.
5.194-
5.195-(defconst hg-commit-message-start
5.196- "--- Enter your commit message. Type `C-c C-c' to commit. ---\n")
5.197-
5.198-(defconst hg-commit-message-end
5.199- "--- Files in bold will be committed. Click to toggle selection. ---\n")
5.200-
5.201-(defconst hg-state-alist
5.202- '((?M . modified)
5.203- (?A . added)
5.204- (?R . removed)
5.205- (?! . deleted)
5.206- (?C . normal)
5.207- (?I . ignored)
5.208- (?? . nil)))
5.209-
5.210-;;; hg-mode keymap.
5.211-
5.212-(defvar hg-prefix-map
5.213- (let ((map (make-sparse-keymap)))
5.214- (hg-feature-cond (xemacs (set-keymap-name map 'hg-prefix-map))) ; XEmacs
5.215- (set-keymap-parent map vc-prefix-map)
5.216- (define-key map "=" 'hg-diff)
5.217- (define-key map "c" 'hg-undo)
5.218- (define-key map "g" 'hg-annotate)
5.219- (define-key map "i" 'hg-add)
5.220- (define-key map "l" 'hg-log)
5.221- (define-key map "n" 'hg-commit-start)
5.222- ;; (define-key map "r" 'hg-update)
5.223- (define-key map "u" 'hg-revert-buffer)
5.224- (define-key map "~" 'hg-version-other-window)
5.225- map)
5.226- "This keymap overrides some default vc-mode bindings.")
5.227-
5.228-(defvar hg-mode-map
5.229- (let ((map (make-sparse-keymap)))
5.230- (define-key map "\C-xv" hg-prefix-map)
5.231- map))
5.232-
5.233-(add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
5.234-
5.235-
5.236-;;; Global keymap.
5.237-
5.238-(defvar hg-global-map
5.239- (let ((map (make-sparse-keymap)))
5.240- (define-key map "," 'hg-incoming)
5.241- (define-key map "." 'hg-outgoing)
5.242- (define-key map "<" 'hg-pull)
5.243- (define-key map "=" 'hg-diff-repo)
5.244- (define-key map ">" 'hg-push)
5.245- (define-key map "?" 'hg-help-overview)
5.246- (define-key map "A" 'hg-addremove)
5.247- (define-key map "U" 'hg-revert)
5.248- (define-key map "a" 'hg-add)
5.249- (define-key map "c" 'hg-commit-start)
5.250- (define-key map "f" 'hg-forget)
5.251- (define-key map "h" 'hg-help-overview)
5.252- (define-key map "i" 'hg-init)
5.253- (define-key map "l" 'hg-log-repo)
5.254- (define-key map "r" 'hg-root)
5.255- (define-key map "s" 'hg-status)
5.256- (define-key map "u" 'hg-update)
5.257- map))
5.258-
5.259-(global-set-key hg-global-prefix hg-global-map)
5.260-
5.261-;;; View mode keymap.
5.262-
5.263-(defvar hg-view-mode-map
5.264- (let ((map (make-sparse-keymap)))
5.265- (hg-feature-cond (xemacs (set-keymap-name map 'hg-view-mode-map))) ; XEmacs
5.266- (define-key map (hg-feature-cond (xemacs [button2])
5.267- (t [mouse-2]))
5.268- 'hg-buffer-mouse-clicked)
5.269- map))
5.270-
5.271-(add-minor-mode 'hg-view-mode "" hg-view-mode-map)
5.272-
5.273-
5.274-;;; Commit mode keymaps.
5.275-
5.276-(defvar hg-commit-mode-map
5.277- (let ((map (make-sparse-keymap)))
5.278- (define-key map "\C-c\C-c" 'hg-commit-finish)
5.279- (define-key map "\C-c\C-k" 'hg-commit-kill)
5.280- (define-key map "\C-xv=" 'hg-diff-repo)
5.281- map))
5.282-
5.283-(defvar hg-commit-mode-file-map
5.284- (let ((map (make-sparse-keymap)))
5.285- (define-key map (hg-feature-cond (xemacs [button2])
5.286- (t [mouse-2]))
5.287- 'hg-commit-mouse-clicked)
5.288- (define-key map " " 'hg-commit-toggle-file)
5.289- (define-key map "\r" 'hg-commit-toggle-file)
5.290- map))
5.291-
5.292-
5.293-;;; Convenience functions.
5.294-
5.295-(defsubst hg-binary ()
5.296- (if hg-binary
5.297- hg-binary
5.298- (error "No `hg' executable found!")))
5.299-
5.300-(defsubst hg-replace-in-string (str regexp newtext &optional literal)
5.301- "Replace all matches in STR for REGEXP with NEWTEXT string.
5.302-Return the new string. Optional LITERAL non-nil means do a literal
5.303-replacement.
5.304-
5.305-This function bridges yet another pointless impedance gap between
5.306-XEmacs and GNU Emacs."
5.307- (hg-feature-cond
5.308- (xemacs (replace-in-string str regexp newtext literal))
5.309- (t (replace-regexp-in-string regexp newtext str nil literal))))
5.310-
5.311-(defsubst hg-strip (str)
5.312- "Strip leading and trailing blank lines from a string."
5.313- (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "")
5.314- "\\`[ \t\r\n]*[\r\n]" ""))
5.315-
5.316-(defsubst hg-chomp (str)
5.317- "Strip trailing newlines from a string."
5.318- (hg-replace-in-string str "[\r\n]+\\'" ""))
5.319-
5.320-(defun hg-run-command (command &rest args)
5.321- "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
5.322-The list ARGS contains a list of arguments to pass to the command."
5.323- (let* (exit-code
5.324- (output
5.325- (with-output-to-string
5.326- (with-current-buffer
5.327- standard-output
5.328- (setq exit-code
5.329- (apply 'call-process command nil t nil args))))))
5.330- (cons exit-code output)))
5.331-
5.332-(defun hg-run (command &rest args)
5.333- "Run the Mercurial command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT)."
5.334- (apply 'hg-run-command (hg-binary) command args))
5.335-
5.336-(defun hg-run0 (command &rest args)
5.337- "Run the Mercurial command COMMAND, returning its output.
5.338-If the command does not exit with a zero status code, raise an error."
5.339- (let ((res (apply 'hg-run-command (hg-binary) command args)))
5.340- (if (not (eq (car res) 0))
5.341- (error "Mercurial command failed %s - exit code %s"
5.342- (cons command args)
5.343- (car res))
5.344- (cdr res))))
5.345-
5.346-(defmacro hg-do-across-repo (path &rest body)
5.347- (let ((root-name (make-symbol "root-"))
5.348- (buf-name (make-symbol "buf-")))
5.349- `(let ((,root-name (hg-root ,path)))
5.350- (save-excursion
5.351- (dolist (,buf-name (buffer-list))
5.352- (set-buffer ,buf-name)
5.353- (when (and hg-status (equal (hg-root buffer-file-name) ,root-name))
5.354- ,@body))))))
5.355-
5.356-(put 'hg-do-across-repo 'lisp-indent-function 1)
5.357-
5.358-(defun hg-sync-buffers (path)
5.359- "Sync buffers visiting PATH with their on-disk copies.
5.360-If PATH is not being visited, but is under the repository root, sync
5.361-all buffers visiting files in the repository."
5.362- (let ((buf (find-buffer-visiting path)))
5.363- (if buf
5.364- (with-current-buffer buf
5.365- (vc-buffer-sync))
5.366- (hg-do-across-repo path
5.367- (vc-buffer-sync)))))
5.368-
5.369-(defun hg-buffer-commands (pnt)
5.370- "Use the properties of a character to do something sensible."
5.371- (interactive "d")
5.372- (let ((rev (get-char-property pnt 'rev))
5.373- (file (get-char-property pnt 'file)))
5.374- (cond
5.375- (file
5.376- (find-file-other-window file))
5.377- (rev
5.378- (hg-diff hg-view-file-name rev rev))
5.379- ((message "I don't know how to do that yet")))))
5.380-
5.381-(defsubst hg-event-point (event)
5.382- "Return the character position of the mouse event EVENT."
5.383- (hg-feature-cond (xemacs (event-point event))
5.384- (t (posn-point (event-start event)))))
5.385-
5.386-(defsubst hg-event-window (event)
5.387- "Return the window over which mouse event EVENT occurred."
5.388- (hg-feature-cond (xemacs (event-window event))
5.389- (t (posn-window (event-start event)))))
5.390-
5.391-(defun hg-buffer-mouse-clicked (event)
5.392- "Translate the mouse clicks in a HG log buffer to character events.
5.393-These are then handed off to `hg-buffer-commands'.
5.394-
5.395-Handle frickin' frackin' gratuitous event-related incompatibilities."
5.396- (interactive "e")
5.397- (select-window (hg-event-window event))
5.398- (hg-buffer-commands (hg-event-point event)))
5.399-
5.400-(defsubst hg-abbrev-file-name (file)
5.401- "Portable wrapper around abbreviate-file-name."
5.402- (hg-feature-cond (xemacs (abbreviate-file-name file t))
5.403- (t (abbreviate-file-name file))))
5.404-
5.405-(defun hg-read-file-name (&optional prompt default)
5.406- "Read a file or directory name, or a pattern, to use with a command."
5.407- (save-excursion
5.408- (while hg-prev-buffer
5.409- (set-buffer hg-prev-buffer))
5.410- (let ((path (or default
5.411- (buffer-file-name)
5.412- (expand-file-name default-directory))))
5.413- (if (or (not path) current-prefix-arg)
5.414- (expand-file-name
5.415- (eval (list* 'read-file-name
5.416- (format "File, directory or pattern%s: "
5.417- (or prompt ""))
5.418- (and path (file-name-directory path))
5.419- nil nil
5.420- (and path (file-name-nondirectory path))
5.421- (hg-feature-cond
5.422- (xemacs (cons (quote 'hg-file-history) nil))
5.423- (t nil)))))
5.424- path))))
5.425-
5.426-(defun hg-read-number (&optional prompt default)
5.427- "Read a integer value."
5.428- (save-excursion
5.429- (if (or (not default) current-prefix-arg)
5.430- (string-to-number
5.431- (eval (list* 'read-string
5.432- (or prompt "")
5.433- (if default (cons (format "%d" default) nil) nil))))
5.434- default)))
5.435-
5.436-(defun hg-read-config ()
5.437- "Return an alist of (key . value) pairs of Mercurial config data.
5.438-Each key is of the form (section . name)."
5.439- (let (items)
5.440- (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
5.441- (string-match "^\\([^=]*\\)=\\(.*\\)" line)
5.442- (let* ((left (substring line (match-beginning 1) (match-end 1)))
5.443- (right (substring line (match-beginning 2) (match-end 2)))
5.444- (key (split-string left "\\."))
5.445- (value (hg-replace-in-string right "\\\\n" "\n" t)))
5.446- (setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
5.447-
5.448-(defun hg-config-section (section config)
5.449- "Return an alist of (name . value) pairs for SECTION of CONFIG."
5.450- (let (items)
5.451- (dolist (item config items)
5.452- (when (equal (caar item) section)
5.453- (setq items (cons (cons (cdar item) (cdr item)) items))))))
5.454-
5.455-(defun hg-string-starts-with (sub str)
5.456- "Indicate whether string STR starts with the substring or character SUB."
5.457- (if (not (stringp sub))
5.458- (and (> (length str) 0) (equal (elt str 0) sub))
5.459- (let ((sub-len (length sub)))
5.460- (and (<= sub-len (length str))
5.461- (string= sub (substring str 0 sub-len))))))
5.462-
5.463-(defun hg-complete-repo (string predicate all)
5.464- "Attempt to complete a repository name.
5.465-We complete on either symbolic names from Mercurial's config or real
5.466-directory names from the file system. We do not penalize URLs."
5.467- (or (if all
5.468- (all-completions string hg-repo-completion-table predicate)
5.469- (try-completion string hg-repo-completion-table predicate))
5.470- (let* ((str (expand-file-name string))
5.471- (dir (file-name-directory str))
5.472- (file (file-name-nondirectory str)))
5.473- (if all
5.474- (let (completions)
5.475- (dolist (name (delete "./" (file-name-all-completions file dir))
5.476- completions)
5.477- (let ((path (concat dir name)))
5.478- (when (file-directory-p path)
5.479- (setq completions (cons name completions))))))
5.480- (let ((comp (file-name-completion file dir)))
5.481- (if comp
5.482- (hg-abbrev-file-name (concat dir comp))))))))
5.483-
5.484-(defun hg-read-repo-name (&optional prompt initial-contents default)
5.485- "Read the location of a repository."
5.486- (save-excursion
5.487- (while hg-prev-buffer
5.488- (set-buffer hg-prev-buffer))
5.489- (let (hg-repo-completion-table)
5.490- (if current-prefix-arg
5.491- (progn
5.492- (dolist (path (hg-config-section "paths" (hg-read-config)))
5.493- (setq hg-repo-completion-table
5.494- (cons (cons (car path) t) hg-repo-completion-table))
5.495- (unless (hg-string-starts-with (hg-feature-cond
5.496- (xemacs directory-sep-char)
5.497- (t ?/))
5.498- (cdr path))
5.499- (setq hg-repo-completion-table
5.500- (cons (cons (cdr path) t) hg-repo-completion-table))))
5.501- (completing-read (format "Repository%s: " (or prompt ""))
5.502- 'hg-complete-repo
5.503- nil
5.504- nil
5.505- initial-contents
5.506- 'hg-repo-history
5.507- default))
5.508- default))))
5.509-
5.510-(defun hg-read-rev (&optional prompt default)
5.511- "Read a revision or tag, offering completions."
5.512- (save-excursion
5.513- (while hg-prev-buffer
5.514- (set-buffer hg-prev-buffer))
5.515- (let ((rev (or default "tip")))
5.516- (if current-prefix-arg
5.517- (let ((revs (split-string
5.518- (hg-chomp
5.519- (hg-run0 "-q" "log" "-l"
5.520- (format "%d" hg-rev-completion-limit)))
5.521- "[\n:]")))
5.522- (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
5.523- (setq revs (cons (car (split-string line "\\s-")) revs)))
5.524- (completing-read (format "Revision%s (%s): "
5.525- (or prompt "")
5.526- (or default "tip"))
5.527- (mapcar (lambda (x) (cons x x)) revs)
5.528- nil
5.529- nil
5.530- nil
5.531- 'hg-rev-history
5.532- (or default "tip")))
5.533- rev))))
5.534-
5.535-(defun hg-parents-for-mode-line (root)
5.536- "Format the parents of the working directory for the mode line."
5.537- (let ((parents (split-string (hg-chomp
5.538- (hg-run0 "--cwd" root "parents" "--template"
5.539- "{rev}\n")) "\n")))
5.540- (mapconcat 'identity parents "+")))
5.541-
5.542-(defun hg-buffers-visiting-repo (&optional path)
5.543- "Return a list of buffers visiting the repository containing PATH."
5.544- (let ((root-name (hg-root (or path (buffer-file-name))))
5.545- bufs)
5.546- (save-excursion
5.547- (dolist (buf (buffer-list) bufs)
5.548- (set-buffer buf)
5.549- (let ((name (buffer-file-name)))
5.550- (when (and hg-status name (equal (hg-root name) root-name))
5.551- (setq bufs (cons buf bufs))))))))
5.552-
5.553-(defun hg-update-mode-lines (path)
5.554- "Update the mode lines of all buffers visiting the same repository as PATH."
5.555- (let* ((root (hg-root path))
5.556- (parents (hg-parents-for-mode-line root)))
5.557- (save-excursion
5.558- (dolist (info (hg-path-status
5.559- root
5.560- (mapcar
5.561- (function
5.562- (lambda (buf)
5.563- (substring (buffer-file-name buf) (length root))))
5.564- (hg-buffers-visiting-repo root))))
5.565- (let* ((name (car info))
5.566- (status (cdr info))
5.567- (buf (find-buffer-visiting (concat root name))))
5.568- (when buf
5.569- (set-buffer buf)
5.570- (hg-mode-line-internal status parents)))))))
5.571-
5.572-
5.573-;;; View mode bits.
5.574-
5.575-(defun hg-exit-view-mode (buf)
5.576- "Exit from hg-view-mode.
5.577-We delete the current window if entering hg-view-mode split the
5.578-current frame."
5.579- (when (and (eq buf (current-buffer))
5.580- (> (length (window-list)) 1))
5.581- (delete-window))
5.582- (when (buffer-live-p buf)
5.583- (kill-buffer buf)))
5.584-
5.585-(defun hg-view-mode (prev-buffer &optional file-name)
5.586- (goto-char (point-min))
5.587- (set-buffer-modified-p nil)
5.588- (setq-local buffer-read-only t)
5.589- (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode))
5.590- (t (view-mode-enter nil 'hg-exit-view-mode)))
5.591- (setq hg-view-mode t)
5.592- (setq truncate-lines t)
5.593- (when file-name
5.594- (setq hg-view-file-name
5.595- (hg-abbrev-file-name file-name))))
5.596-
5.597-(defun hg-file-status (file)
5.598- "Return status of FILE, or nil if FILE does not exist or is unmanaged."
5.599- (let* ((s (hg-run "status" file))
5.600- (exit (car s))
5.601- (output (cdr s)))
5.602- (if (= exit 0)
5.603- (let ((state (and (>= (length output) 2)
5.604- (= (aref output 1) ? )
5.605- (assq (aref output 0) hg-state-alist))))
5.606- (if state
5.607- (cdr state)
5.608- 'normal)))))
5.609-
5.610-(defun hg-path-status (root paths)
5.611- "Return status of PATHS in repo ROOT as an alist.
5.612-Each entry is a pair (FILE-NAME . STATUS)."
5.613- (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
5.614- result)
5.615- (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
5.616- (let (state name)
5.617- (cond ((= (aref entry 1) ? )
5.618- (setq state (assq (aref entry 0) hg-state-alist)
5.619- name (substring entry 2)))
5.620- ((string-match "\\(.*\\): " entry)
5.621- (setq name (match-string 1 entry))))
5.622- (setq result (cons (cons name state) result))))))
5.623-
5.624-(defmacro hg-view-output (args &rest body)
5.625- "Execute BODY in a clean buffer, then quickly display that buffer.
5.626-If the buffer contains one line, its contents are displayed in the
5.627-minibuffer. Otherwise, the buffer is displayed in view-mode.
5.628-ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
5.629-the name of the buffer to create, and FILE is the name of the file
5.630-being viewed."
5.631- (let ((prev-buf (make-symbol "prev-buf-"))
5.632- (v-b-name (car args))
5.633- (v-m-rest (cdr args)))
5.634- `(let ((view-buf-name ,v-b-name)
5.635- (,prev-buf (current-buffer)))
5.636- (get-buffer-create view-buf-name)
5.637- (kill-buffer view-buf-name)
5.638- (get-buffer-create view-buf-name)
5.639- (set-buffer view-buf-name)
5.640- (save-excursion
5.641- ,@body)
5.642- (cl-case (count-lines (point-min) (point-max))
5.643- ((0)
5.644- (kill-buffer view-buf-name)
5.645- (message "(No output)"))
5.646- ((1)
5.647- (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
5.648- (kill-buffer view-buf-name)
5.649- (message "%s" msg)))
5.650- (t
5.651- (pop-to-buffer view-buf-name)
5.652- (setq hg-prev-buffer ,prev-buf)
5.653- (hg-view-mode ,prev-buf ,@v-m-rest))))))
5.654-
5.655-(put 'hg-view-output 'lisp-indent-function 1)
5.656-
5.657-;;; Context save and restore across revert and other operations.
5.658-
5.659-(defun hg-position-context (pos)
5.660- "Return information to help find the given position again."
5.661- (let* ((end (min (point-max) (+ pos 98))))
5.662- (list pos
5.663- (buffer-substring (max (point-min) (- pos 2)) end)
5.664- (- end pos))))
5.665-
5.666-(defun hg-buffer-context ()
5.667- "Return information to help restore a user's editing context.
5.668-This is useful across reverts and merges, where a context is likely
5.669-to have moved a little, but not really changed."
5.670- (let ((point-context (hg-position-context (point)))
5.671- (mark-context (let ((mark (mark-marker)))
5.672- (and mark
5.673- ;; make sure active mark
5.674- (marker-buffer mark)
5.675- (marker-position mark)
5.676- (hg-position-context mark)))))
5.677- (list point-context mark-context)))
5.678-
5.679-(defun hg-find-context (ctx)
5.680- "Attempt to find a context in the given buffer.
5.681-Always returns a valid, hopefully sane, position."
5.682- (let ((pos (nth 0 ctx))
5.683- (str (nth 1 ctx))
5.684- (fixup (nth 2 ctx)))
5.685- (save-excursion
5.686- (goto-char (max (point-min) (- pos 15000)))
5.687- (if (and (not (equal str ""))
5.688- (search-forward str nil t))
5.689- (- (point) fixup)
5.690- (max pos (point-min))))))
5.691-
5.692-(defun hg-restore-context (ctx)
5.693- "Attempt to restore the user's editing context."
5.694- (let ((point-context (nth 0 ctx))
5.695- (mark-context (nth 1 ctx)))
5.696- (goto-char (hg-find-context point-context))
5.697- (when mark-context
5.698- (set-mark (hg-find-context mark-context)))))
5.699-
5.700-
5.701-;;; Hooks.
5.702-
5.703-(defun hg-mode-line-internal (status parents)
5.704- (setq hg-status status
5.705- hg-mode (and status (concat " Hg:"
5.706- parents
5.707- (cdr (assq status
5.708- '((normal . "")
5.709- (removed . "r")
5.710- (added . "a")
5.711- (deleted . "!")
5.712- (modified . "m"))))))))
5.713-
5.714-(defun hg-mode-line (&optional force)
5.715- "Update the modeline with the current status of a file.
5.716-An update occurs if optional argument FORCE is non-nil,
5.717-hg-update-modeline is non-nil, or we have not yet checked the state of
5.718-the file."
5.719- (let ((root (hg-root)))
5.720- (when (and root (or force hg-update-modeline (not hg-mode)))
5.721- (let ((status (hg-file-status buffer-file-name))
5.722- (parents (hg-parents-for-mode-line root)))
5.723- (hg-mode-line-internal status parents)
5.724- status))))
5.725-
5.726-(defun hg-mode (&optional toggle)
5.727- "Minor mode for Mercurial distributed SCM integration.
5.728-
5.729-The Mercurial mode user interface is based on that of VC mode, so if
5.730-you're already familiar with VC, the same keybindings and functions
5.731-will generally work.
5.732-
5.733-Below is a list of many common SCM tasks. In the list, `G/L\'
5.734-indicates whether a key binding is global (G) to a repository or
5.735-local (L) to a file. Many commands take a prefix argument.
5.736-
5.737-SCM Task G/L Key Binding Command Name
5.738--------- --- ----------- ------------
5.739-Help overview (what you are reading) G C-c h h hg-help-overview
5.740-
5.741-Tell Mercurial to manage a file G C-c h a hg-add
5.742-Commit changes to current file only L C-x v n hg-commit-start
5.743-Undo changes to file since commit L C-x v u hg-revert-buffer
5.744-
5.745-Diff file vs last checkin L C-x v = hg-diff
5.746-
5.747-View file change history L C-x v l hg-log
5.748-View annotated file L C-x v a hg-annotate
5.749-
5.750-Diff repo vs last checkin G C-c h = hg-diff-repo
5.751-View status of files in repo G C-c h s hg-status
5.752-Commit all changes G C-c h c hg-commit-start
5.753-
5.754-Undo all changes since last commit G C-c h U hg-revert
5.755-View repo change history G C-c h l hg-log-repo
5.756-
5.757-See changes that can be pulled G C-c h , hg-incoming
5.758-Pull changes G C-c h < hg-pull
5.759-Update working directory after pull G C-c h u hg-update
5.760-See changes that can be pushed G C-c h . hg-outgoing
5.761-Push changes G C-c h > hg-push"
5.762- (unless vc-make-backup-files
5.763- (set (make-local-variable 'backup-inhibited) t))
5.764- (run-hooks 'hg-mode-hook))
5.765-
5.766-(defun hg-find-file-hook ()
5.767- (ignore-errors
5.768- (when (hg-mode-line)
5.769- (hg-mode))))
5.770-
5.771-(add-hook 'find-file-hooks 'hg-find-file-hook)
5.772-
5.773-(defun hg-after-save-hook ()
5.774- (ignore-errors
5.775- (let ((old-status hg-status))
5.776- (hg-mode-line)
5.777- (if (and (not old-status) hg-status)
5.778- (hg-mode)))))
5.779-
5.780-(add-hook 'after-save-hook 'hg-after-save-hook)
5.781-
5.782-
5.783-;;; User interface functions.
5.784-
5.785-(defun hg-help-overview ()
5.786- "This is an overview of the Mercurial SCM mode for Emacs.
5.787-
5.788-You can find the source code, license (GPLv2+), and credits for this
5.789-code by typing `M-x find-library mercurial RET'."
5.790- (interactive)
5.791- (hg-view-output ("Mercurial Help Overview")
5.792- (insert (documentation 'hg-help-overview))
5.793- (let ((pos (point)))
5.794- (insert (documentation 'hg-mode))
5.795- (goto-char pos)
5.796- (end-of-line 1)
5.797- (delete-region pos (point)))
5.798- (let ((hg-root-dir (hg-root)))
5.799- (if (not hg-root-dir)
5.800- (error "error: %s: directory is not part of a Mercurial repository."
5.801- default-directory)
5.802- (cd hg-root-dir)))))
5.803-
5.804-(defun hg-fix-paths ()
5.805- "Fix paths reported by some Mercurial commands."
5.806- (save-excursion
5.807- (goto-char (point-min))
5.808- (while (re-search-forward " \\.\\.." nil t)
5.809- (replace-match " " nil nil))))
5.810-
5.811-(defun hg-add (path)
5.812- "Add PATH to the Mercurial repository on the next commit.
5.813-With a prefix argument, prompt for the path to add."
5.814- (interactive (list (hg-read-file-name " to add")))
5.815- (let ((buf (current-buffer))
5.816- (update (equal buffer-file-name path)))
5.817- (hg-view-output (hg-output-buffer-name)
5.818- (apply 'call-process (hg-binary) nil t nil (list "add" path))
5.819- (hg-fix-paths)
5.820- (goto-char (point-min))
5.821- (cd (hg-root path)))
5.822- (when update
5.823- (unless vc-make-backup-files
5.824- (set (make-local-variable 'backup-inhibited) t))
5.825- (with-current-buffer buf
5.826- (hg-mode-line)))))
5.827-
5.828-(defun hg-addremove ()
5.829- (interactive)
5.830- (error "not implemented"))
5.831-
5.832-(defun hg-annotate ()
5.833- (interactive)
5.834- (error "not implemented"))
5.835-
5.836-(defun hg-commit-toggle-file (pos)
5.837- "Toggle whether or not the file at POS will be committed."
5.838- (interactive "d")
5.839- (save-excursion
5.840- (goto-char pos)
5.841- (let (face
5.842- (inhibit-read-only t)
5.843- bol)
5.844- (beginning-of-line)
5.845- (setq bol (+ (point) 4))
5.846- (setq face (get-text-property bol 'face))
5.847- (end-of-line)
5.848- (if (eq face 'bold)
5.849- (progn
5.850- (remove-text-properties bol (point) '(face nil))
5.851- (message "%s will not be committed"
5.852- (buffer-substring bol (point))))
5.853- (add-text-properties bol (point) '(face bold))
5.854- (message "%s will be committed"
5.855- (buffer-substring bol (point)))))))
5.856-
5.857-(defun hg-commit-mouse-clicked (event)
5.858- "Toggle whether or not the file at POS will be committed."
5.859- (interactive "@e")
5.860- (hg-commit-toggle-file (hg-event-point event)))
5.861-
5.862-(defun hg-commit-kill ()
5.863- "Kill the commit currently being prepared."
5.864- (interactive)
5.865- (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
5.866- (let ((buf hg-prev-buffer))
5.867- (kill-buffer nil)
5.868- (switch-to-buffer buf))))
5.869-
5.870-(defun hg-commit-finish ()
5.871- "Finish preparing a commit, and perform the actual commit.
5.872-The hook hg-pre-commit-hook is run before anything else is done. If
5.873-the commit message is empty and hg-commit-allow-empty-message is nil,
5.874-an error is raised. If the list of files to commit is empty and
5.875-hg-commit-allow-empty-file-list is nil, an error is raised."
5.876- (interactive)
5.877- (let ((root hg-root))
5.878- (save-excursion
5.879- (run-hooks 'hg-pre-commit-hook)
5.880- (goto-char (point-min))
5.881- (search-forward hg-commit-message-start)
5.882- (let (message files)
5.883- (let ((start (point)))
5.884- (goto-char (point-max))
5.885- (search-backward hg-commit-message-end)
5.886- (setq message (hg-strip (buffer-substring start (point)))))
5.887- (when (and (= (length message) 0)
5.888- (not hg-commit-allow-empty-message))
5.889- (error "Cannot proceed - commit message is empty"))
5.890- (forward-line 1)
5.891- (beginning-of-line)
5.892- (while (< (point) (point-max))
5.893- (let ((pos (+ (point) 4)))
5.894- (end-of-line)
5.895- (when (eq (get-text-property pos 'face) 'bold)
5.896- (end-of-line)
5.897- (setq files (cons (buffer-substring pos (point)) files))))
5.898- (forward-line 1))
5.899- (when (and (= (length files) 0)
5.900- (not hg-commit-allow-empty-file-list))
5.901- (error "Cannot proceed - no files to commit"))
5.902- (setq message (concat message "\n"))
5.903- (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
5.904- (let ((buf hg-prev-buffer))
5.905- (kill-buffer nil)
5.906- (switch-to-buffer buf))
5.907- (hg-update-mode-lines root))))
5.908-
5.909-(defun hg-commit-mode ()
5.910- "Mode for describing a commit of changes to a Mercurial repository.
5.911-This involves two actions: describing the changes with a commit
5.912-message, and choosing the files to commit.
5.913-
5.914-To describe the commit, simply type some text in the designated area.
5.915-
5.916-By default, all modified, added and removed files are selected for
5.917-committing. Files that will be committed are displayed in bold face\;
5.918-those that will not are displayed in normal face.
5.919-
5.920-To toggle whether a file will be committed, move the cursor over a
5.921-particular file and hit space or return. Alternatively, middle click
5.922-on the file.
5.923-
5.924-Key bindings
5.925-------------
5.926-\\[hg-commit-finish] proceed with commit
5.927-\\[hg-commit-kill] kill commit
5.928-
5.929-\\[hg-diff-repo] view diff of pending changes"
5.930- (interactive)
5.931- (use-local-map hg-commit-mode-map)
5.932- (set-syntax-table text-mode-syntax-table)
5.933- (setq local-abbrev-table text-mode-abbrev-table
5.934- major-mode 'hg-commit-mode
5.935- mode-name "Hg-Commit")
5.936- (set-buffer-modified-p nil)
5.937- (setq buffer-undo-list nil)
5.938- (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
5.939-
5.940-(defun hg-commit-start ()
5.941- "Prepare a commit of changes to the repository containing the current file."
5.942- (interactive)
5.943- (while hg-prev-buffer
5.944- (set-buffer hg-prev-buffer))
5.945- (let ((root (hg-root))
5.946- (prev-buffer (current-buffer))
5.947- modified-files)
5.948- (unless root
5.949- (error "Cannot commit outside a repository!"))
5.950- (hg-sync-buffers root)
5.951- (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
5.952- (when (and (= (length modified-files) 0)
5.953- (not hg-commit-allow-empty-file-list))
5.954- (error "No pending changes to commit"))
5.955- (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
5.956- (pop-to-buffer (get-buffer-create buf-name))
5.957- (when (= (point-min) (point-max))
5.958- (set (make-local-variable 'hg-root) root)
5.959- (setq hg-prev-buffer prev-buffer)
5.960- (insert "\n")
5.961- (let ((bol (point)))
5.962- (insert hg-commit-message-end)
5.963- (add-text-properties bol (point) '(face bold-italic)))
5.964- (let ((file-area (point)))
5.965- (insert modified-files)
5.966- (goto-char file-area)
5.967- (while (< (point) (point-max))
5.968- (let ((bol (point)))
5.969- (forward-char 1)
5.970- (insert " ")
5.971- (end-of-line)
5.972- (add-text-properties (+ bol 4) (point)
5.973- '(face bold mouse-face highlight)))
5.974- (forward-line 1))
5.975- (goto-char file-area)
5.976- (add-text-properties (point) (point-max)
5.977- `(keymap ,hg-commit-mode-file-map))
5.978- (goto-char (point-min))
5.979- (insert hg-commit-message-start)
5.980- (add-text-properties (point-min) (point) '(face bold-italic))
5.981- (insert "\n\n")
5.982- (forward-line -1)
5.983- (save-excursion
5.984- (goto-char (point-max))
5.985- (search-backward hg-commit-message-end)
5.986- (add-text-properties (match-beginning 0) (point-max)
5.987- '(read-only t))
5.988- (goto-char (point-min))
5.989- (search-forward hg-commit-message-start)
5.990- (add-text-properties (match-beginning 0) (match-end 0)
5.991- '(read-only t)))
5.992- (hg-commit-mode)
5.993- (cd root))))))
5.994-
5.995-(defun hg-diff (path &optional rev1 rev2)
5.996- "Show the differences between REV1 and REV2 of PATH.
5.997-When called interactively, the default behaviour is to treat REV1 as
5.998-the \"parent\" revision, REV2 as the current edited version of the file, and
5.999-PATH as the file edited in the current buffer.
5.1000-With a prefix argument, prompt for all of these."
5.1001- (interactive (list (hg-read-file-name " to diff")
5.1002- (let ((rev1 (hg-read-rev " to start with" 'parent)))
5.1003- (and (not (eq rev1 'parent)) rev1))
5.1004- (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
5.1005- (and (not (eq rev2 'working-dir)) rev2))))
5.1006- (hg-sync-buffers path)
5.1007- (let ((a-path (hg-abbrev-file-name path))
5.1008- ;; none revision is specified explicitly
5.1009- (none (and (not rev1) (not rev2)))
5.1010- ;; only one revision is specified explicitly
5.1011- (one (or (and (or (equal rev1 rev2) (not rev2)) rev1)
5.1012- (and (not rev1) rev2)))
5.1013- diff)
5.1014- (hg-view-output ((cond
5.1015- (none
5.1016- (format "Mercurial: Diff against parent of %s" a-path))
5.1017- (one
5.1018- (format "Mercurial: Diff of rev %s of %s" one a-path))
5.1019- (t
5.1020- (format "Mercurial: Diff from rev %s to %s of %s"
5.1021- rev1 rev2 a-path))))
5.1022- (cond
5.1023- (none
5.1024- (call-process (hg-binary) nil t nil "diff" path))
5.1025- (one
5.1026- (call-process (hg-binary) nil t nil "diff" "-r" one path))
5.1027- (t
5.1028- (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
5.1029- (diff-mode)
5.1030- (setq diff (not (= (point-min) (point-max))))
5.1031- (font-lock-fontify-buffer)
5.1032- (cd (hg-root path)))
5.1033- diff))
5.1034-
5.1035-(defun hg-diff-repo (path &optional rev1 rev2)
5.1036- "Show the differences between REV1 and REV2 of repository containing PATH.
5.1037-When called interactively, the default behaviour is to treat REV1 as
5.1038-the \"parent\" revision, REV2 as the current edited version of the file, and
5.1039-PATH as the `hg-root' of the current buffer.
5.1040-With a prefix argument, prompt for all of these."
5.1041- (interactive (list (hg-read-file-name " to diff")
5.1042- (let ((rev1 (hg-read-rev " to start with" 'parent)))
5.1043- (and (not (eq rev1 'parent)) rev1))
5.1044- (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
5.1045- (and (not (eq rev2 'working-dir)) rev2))))
5.1046- (hg-diff (hg-root path) rev1 rev2))
5.1047-
5.1048-(defun hg-forget (path)
5.1049- "Lose track of PATH, which has been added, but not yet committed.
5.1050-This will prevent the file from being incorporated into the Mercurial
5.1051-repository on the next commit.
5.1052-With a prefix argument, prompt for the path to forget."
5.1053- (interactive (list (hg-read-file-name " to forget")))
5.1054- (let ((buf (current-buffer))
5.1055- (update (equal buffer-file-name path)))
5.1056- (hg-view-output (hg-output-buffer-name)
5.1057- (apply 'call-process (hg-binary) nil t nil (list "forget" path))
5.1058- ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
5.1059- (hg-fix-paths)
5.1060- (goto-char (point-min))
5.1061- (cd (hg-root path)))
5.1062- (when update
5.1063- (with-current-buffer buf
5.1064- (when (local-variable-p 'backup-inhibited)
5.1065- (kill-local-variable 'backup-inhibited))
5.1066- (hg-mode-line)))))
5.1067-
5.1068-(defun hg-incoming (&optional repo)
5.1069- "Display changesets present in REPO that are not present locally."
5.1070- (interactive (list (hg-read-repo-name " where changes would come from")))
5.1071- (hg-view-output ((format "Mercurial: Incoming from %s to %s"
5.1072- (hg-abbrev-file-name (hg-root))
5.1073- (hg-abbrev-file-name
5.1074- (or repo hg-incoming-repository))))
5.1075- (call-process (hg-binary) nil t nil "incoming"
5.1076- (or repo hg-incoming-repository))
5.1077- (hg-log-mode)
5.1078- (cd (hg-root))))
5.1079-
5.1080-(defun hg-init ()
5.1081- (interactive)
5.1082- (error "not implemented"))
5.1083-
5.1084-(defun hg-log-mode ()
5.1085- "Mode for viewing a Mercurial change log."
5.1086- (goto-char (point-min))
5.1087- (when (looking-at "^searching for changes.*$")
5.1088- (delete-region (match-beginning 0) (match-end 0)))
5.1089- (run-hooks 'hg-log-mode-hook))
5.1090-
5.1091-(defun hg-log (path &optional rev1 rev2 log-limit)
5.1092- "Display the revision history of PATH.
5.1093-History is displayed between REV1 and REV2.
5.1094-Number of displayed changesets is limited to LOG-LIMIT.
5.1095-REV1 defaults to the tip, while REV2 defaults to 0.
5.1096-LOG-LIMIT defaults to `hg-log-limit'.
5.1097-With a prefix argument, prompt for each parameter."
5.1098- (interactive (list (hg-read-file-name " to log")
5.1099- (hg-read-rev " to start with"
5.1100- "tip")
5.1101- (hg-read-rev " to end with"
5.1102- "0")
5.1103- (hg-read-number "Output limited to: "
5.1104- hg-log-limit)))
5.1105- (let ((a-path (hg-abbrev-file-name path))
5.1106- (r1 (or rev1 "tip"))
5.1107- (r2 (or rev2 "0"))
5.1108- (limit (format "%d" (or log-limit hg-log-limit))))
5.1109- (hg-view-output ((if (equal r1 r2)
5.1110- (format "Mercurial: Log of rev %s of %s" rev1 a-path)
5.1111- (format
5.1112- "Mercurial: at most %s log(s) from rev %s to %s of %s"
5.1113- limit r1 r2 a-path)))
5.1114- (eval (list* 'call-process (hg-binary) nil t nil
5.1115- "log"
5.1116- "-r" (format "%s:%s" r1 r2)
5.1117- "-l" limit
5.1118- (if (> (length path) (length (hg-root path)))
5.1119- (cons path nil)
5.1120- nil)))
5.1121- (hg-log-mode)
5.1122- (cd (hg-root path)))))
5.1123-
5.1124-(defun hg-log-repo (path &optional rev1 rev2 log-limit)
5.1125- "Display the revision history of the repository containing PATH.
5.1126-History is displayed between REV1 and REV2.
5.1127-Number of displayed changesets is limited to LOG-LIMIT,
5.1128-REV1 defaults to the tip, while REV2 defaults to 0.
5.1129-LOG-LIMIT defaults to `hg-log-limit'.
5.1130-With a prefix argument, prompt for each parameter."
5.1131- (interactive (list (hg-read-file-name " to log")
5.1132- (hg-read-rev " to start with"
5.1133- "tip")
5.1134- (hg-read-rev " to end with"
5.1135- "0")
5.1136- (hg-read-number "Output limited to: "
5.1137- hg-log-limit)))
5.1138- (hg-log (hg-root path) rev1 rev2 log-limit))
5.1139-
5.1140-(defun hg-outgoing (&optional repo)
5.1141- "Display changesets present locally that are not present in REPO."
5.1142- (interactive (list (hg-read-repo-name " where changes would go to" nil
5.1143- hg-outgoing-repository)))
5.1144- (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
5.1145- (hg-abbrev-file-name (hg-root))
5.1146- (hg-abbrev-file-name
5.1147- (or repo hg-outgoing-repository))))
5.1148- (call-process (hg-binary) nil t nil "outgoing"
5.1149- (or repo hg-outgoing-repository))
5.1150- (hg-log-mode)
5.1151- (cd (hg-root))))
5.1152-
5.1153-(defun hg-pull (&optional repo)
5.1154- "Pull changes from repository REPO.
5.1155-This does not update the working directory."
5.1156- (interactive (list (hg-read-repo-name " to pull from")))
5.1157- (hg-view-output ((format "Mercurial: Pull to %s from %s"
5.1158- (hg-abbrev-file-name (hg-root))
5.1159- (hg-abbrev-file-name
5.1160- (or repo hg-incoming-repository))))
5.1161- (call-process (hg-binary) nil t nil "pull"
5.1162- (or repo hg-incoming-repository))
5.1163- (cd (hg-root))))
5.1164-
5.1165-(defun hg-push (&optional repo)
5.1166- "Push changes to repository REPO."
5.1167- (interactive (list (hg-read-repo-name " to push to")))
5.1168- (hg-view-output ((format "Mercurial: Push from %s to %s"
5.1169- (hg-abbrev-file-name (hg-root))
5.1170- (hg-abbrev-file-name
5.1171- (or repo hg-outgoing-repository))))
5.1172- (call-process (hg-binary) nil t nil "push"
5.1173- (or repo hg-outgoing-repository))
5.1174- (cd (hg-root))))
5.1175-
5.1176-(defun hg-revert-buffer-internal ()
5.1177- (let ((ctx (hg-buffer-context)))
5.1178- (message "Reverting %s..." buffer-file-name)
5.1179- (hg-run0 "revert" buffer-file-name)
5.1180- (revert-buffer t t t)
5.1181- (hg-restore-context ctx)
5.1182- (hg-mode-line)
5.1183- (message "Reverting %s...done" buffer-file-name)))
5.1184-
5.1185-(defun hg-revert-buffer ()
5.1186- "Revert current buffer's file back to the latest committed version.
5.1187-If the file has not changed, nothing happens. Otherwise, this
5.1188-displays a diff and asks for confirmation before reverting."
5.1189- (interactive)
5.1190- (let ((vc-suppress-confirm nil)
5.1191- (obuf (current-buffer))
5.1192- diff)
5.1193- (vc-buffer-sync)
5.1194- (unwind-protect
5.1195- (setq diff (hg-diff buffer-file-name))
5.1196- (when diff
5.1197- (unless (yes-or-no-p "Discard changes? ")
5.1198- (error "Revert cancelled")))
5.1199- (when diff
5.1200- (let ((buf (current-buffer)))
5.1201- (delete-window (selected-window))
5.1202- (kill-buffer buf))))
5.1203- (set-buffer obuf)
5.1204- (when diff
5.1205- (hg-revert-buffer-internal))))
5.1206-
5.1207-(defun hg-root (&optional path)
5.1208- "Return the root of the repository that contains the given path.
5.1209-If the path is outside a repository, return nil.
5.1210-When called interactively, the root is printed. A prefix argument
5.1211-prompts for a path to check."
5.1212- (interactive (list (hg-read-file-name)))
5.1213- (if (or path (not hg-root))
5.1214- (let ((root (cl-do ((prev nil dir)
5.1215- (dir (file-name-directory
5.1216- (or
5.1217- path
5.1218- buffer-file-name
5.1219- (expand-file-name default-directory)))
5.1220- (file-name-directory (directory-file-name dir))))
5.1221- ((equal prev dir))
5.1222- (when (file-directory-p (concat dir ".hg"))
5.1223- (cl-return dir)))))
5.1224- (when (interactive-p)
5.1225- (if root
5.1226- (message "The root of this repository is `%s'." root)
5.1227- (message "The path `%s' is not in a Mercurial repository."
5.1228- (hg-abbrev-file-name path))))
5.1229- root)
5.1230- hg-root))
5.1231-
5.1232-(defun hg-cwd (&optional path)
5.1233- "Return the current directory of PATH within the repository."
5.1234- (cl-do ((stack nil (cons (file-name-nondirectory
5.1235- (directory-file-name dir))
5.1236- stack))
5.1237- (prev nil dir)
5.1238- (dir (file-name-directory (or path buffer-file-name
5.1239- (expand-file-name default-directory)))
5.1240- (file-name-directory (directory-file-name dir))))
5.1241- ((equal prev dir))
5.1242- (when (file-directory-p (concat dir ".hg"))
5.1243- (let ((cwd (mapconcat 'identity stack "/")))
5.1244- (unless (equal cwd "")
5.1245- (cl-return (file-name-as-directory cwd)))))))
5.1246-
5.1247-(defun hg-status (path)
5.1248- "Print revision control status of a file or directory.
5.1249-With prefix argument, prompt for the path to give status for.
5.1250-Names are displayed relative to the repository root."
5.1251- (interactive (list (hg-read-file-name " for status" (hg-root))))
5.1252- (let ((root (hg-root)))
5.1253- (hg-view-output ((format "Mercurial: Status of %s in %s"
5.1254- (let ((name (substring (expand-file-name path)
5.1255- (length root))))
5.1256- (if (> (length name) 0)
5.1257- name
5.1258- "*"))
5.1259- (hg-abbrev-file-name root)))
5.1260- (apply 'call-process (hg-binary) nil t nil
5.1261- (list "--cwd" root "status" path))
5.1262- (cd (hg-root path)))))
5.1263-
5.1264-(defun hg-undo ()
5.1265- (interactive)
5.1266- (error "not implemented"))
5.1267-
5.1268-(defun hg-update ()
5.1269- (interactive)
5.1270- (error "not implemented"))
5.1271-
5.1272-(defun hg-version-other-window (rev)
5.1273- "Visit version REV of the current file in another window.
5.1274-If the current file is named `F', the version is named `F.~REV~'.
5.1275-If `F.~REV~' already exists, use it instead of checking it out again."
5.1276- (interactive "sVersion to visit (default is workfile version): ")
5.1277- (let* ((file buffer-file-name)
5.1278- (version (if (string-equal rev "")
5.1279- "tip"
5.1280- rev))
5.1281- (automatic-backup (vc-version-backup-file-name file version))
5.1282- (manual-backup (vc-version-backup-file-name file version 'manual)))
5.1283- (unless (file-exists-p manual-backup)
5.1284- (if (file-exists-p automatic-backup)
5.1285- (rename-file automatic-backup manual-backup nil)
5.1286- (hg-run0 "-q" "cat" "-r" version "-o" manual-backup file)))
5.1287- (find-file-other-window manual-backup)))
5.1288-
5.1289-(provide 'mercurial)
6.1--- a/emacs/lib/mq.el Sun Nov 26 16:43:15 2023 -0500
6.2+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
6.3@@ -1,410 +0,0 @@
6.4-;;; mq.el --- Emacs support for Mercurial Queues
6.5-
6.6-;; Copyright (C) 2006 Bryan O'Sullivan
6.7-
6.8-;; Author: Bryan O'Sullivan <bos@serpentine.com>
6.9-
6.10-;; mq.el is free software; you can redistribute it and/or modify it
6.11-;; under the terms of the GNU General Public License version 2 or any
6.12-;; later version.
6.13-
6.14-;; mq.el is distributed in the hope that it will be useful, but
6.15-;; WITHOUT ANY WARRANTY; without even the implied warranty of
6.16-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
6.17-;; General Public License for more details.
6.18-
6.19-;; You should have received a copy of the GNU General Public License
6.20-;; along with mq.el, GNU Emacs, or XEmacs; see the file COPYING (`C-h
6.21-;; C-l'). If not, see <http://www.gnu.org/licenses/>.
6.22-(eval-when-compile (require 'cl-lib))
6.23-(require 'mercurial)
6.24-
6.25-
6.26-(defcustom mq-mode-hook nil
6.27- "Hook run when a buffer enters mq-mode."
6.28- :type 'sexp
6.29- :group 'mercurial)
6.30-
6.31-(defcustom mq-global-prefix "\C-cq"
6.32- "The global prefix for Mercurial Queues keymap bindings."
6.33- :type 'sexp
6.34- :group 'mercurial)
6.35-
6.36-(defcustom mq-edit-mode-hook nil
6.37- "Hook run after a buffer is populated to edit a patch description."
6.38- :type 'sexp
6.39- :group 'mercurial)
6.40-
6.41-(defcustom mq-edit-finish-hook nil
6.42- "Hook run before a patch description is finished up with."
6.43- :type 'sexp
6.44- :group 'mercurial)
6.45-
6.46-(defcustom mq-signoff-address nil
6.47- "Address with which to sign off on a patch."
6.48- :type 'string
6.49- :group 'mercurial)
6.50-
6.51-
6.52-;;; Internal variables.
6.53-
6.54-(defvar mq-mode nil
6.55- "Is this file managed by MQ?")
6.56-(make-variable-buffer-local 'mq-mode)
6.57-(put 'mq-mode 'permanent-local t)
6.58-
6.59-(defvar mq-patch-history nil)
6.60-
6.61-(defvar mq-top-patch '(nil))
6.62-
6.63-(defvar mq-prev-buffer nil)
6.64-(make-variable-buffer-local 'mq-prev-buffer)
6.65-(put 'mq-prev-buffer 'permanent-local t)
6.66-
6.67-(defvar mq-top nil)
6.68-(make-variable-buffer-local 'mq-top)
6.69-(put 'mq-top 'permanent-local t)
6.70-
6.71-;;; Global keymap.
6.72-
6.73-(defvar mq-global-map
6.74- (let ((map (make-sparse-keymap)))
6.75- (define-key map "." 'mq-push)
6.76- (define-key map ">" 'mq-push-all)
6.77- (define-key map "," 'mq-pop)
6.78- (define-key map "<" 'mq-pop-all)
6.79- (define-key map "=" 'mq-diff)
6.80- (define-key map "r" 'mq-refresh)
6.81- (define-key map "e" 'mq-refresh-edit)
6.82- (define-key map "i" 'mq-new)
6.83- (define-key map "n" 'mq-next)
6.84- (define-key map "o" 'mq-signoff)
6.85- (define-key map "p" 'mq-previous)
6.86- (define-key map "s" 'mq-edit-series)
6.87- (define-key map "t" 'mq-top)
6.88- map))
6.89-
6.90-(global-set-key mq-global-prefix mq-global-map)
6.91-
6.92-(add-minor-mode 'mq-mode 'mq-mode)
6.93-
6.94-
6.95-;;; Refresh edit mode keymap.
6.96-
6.97-(defvar mq-edit-mode-map
6.98- (let ((map (make-sparse-keymap)))
6.99- (define-key map "\C-c\C-c" 'mq-edit-finish)
6.100- (define-key map "\C-c\C-k" 'mq-edit-kill)
6.101- (define-key map "\C-c\C-s" 'mq-signoff)
6.102- map))
6.103-
6.104-
6.105-;;; Helper functions.
6.106-
6.107-(defun mq-read-patch-name (&optional source prompt force)
6.108- "Read a patch name to use with a command.
6.109-May return nil, meaning \"use the default\"."
6.110- (let ((patches (split-string
6.111- (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
6.112- (when force
6.113- (completing-read (format "Patch%s: " (or prompt ""))
6.114- (mapcar (lambda (x) (cons x x)) patches)
6.115- nil
6.116- nil
6.117- nil
6.118- 'mq-patch-history))))
6.119-
6.120-(defun mq-refresh-buffers (root)
6.121- (save-excursion
6.122- (dolist (buf (hg-buffers-visiting-repo root))
6.123- (when (not (verify-visited-file-modtime buf))
6.124- (set-buffer buf)
6.125- (let ((ctx (hg-buffer-context)))
6.126- (message "Refreshing %s..." (buffer-name))
6.127- (revert-buffer t t t)
6.128- (hg-restore-context ctx)
6.129- (message "Refreshing %s...done" (buffer-name))))))
6.130- (hg-update-mode-lines root)
6.131- (mq-update-mode-lines root))
6.132-
6.133-(defun mq-last-line ()
6.134- (goto-char (point-max))
6.135- (beginning-of-line)
6.136- (when (looking-at "^$")
6.137- (forward-line -1))
6.138- (let ((bol (point)))
6.139- (end-of-line)
6.140- (let ((line (buffer-substring bol (point))))
6.141- (when (> (length line) 0)
6.142- line))))
6.143-
6.144-(defun mq-push (&optional patch)
6.145- "Push patches until PATCH is reached.
6.146-If PATCH is nil, push at most one patch."
6.147- (interactive (list (mq-read-patch-name "qunapplied" " to push"
6.148- current-prefix-arg)))
6.149- (let ((root (hg-root))
6.150- (prev-buf (current-buffer))
6.151- last-line ok)
6.152- (unless root
6.153- (error "Cannot push outside a repository!"))
6.154- (hg-sync-buffers root)
6.155- (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
6.156- (kill-buffer (get-buffer-create buf-name))
6.157- (split-window-vertically)
6.158- (other-window 1)
6.159- (switch-to-buffer (get-buffer-create buf-name))
6.160- (cd root)
6.161- (message "Pushing...")
6.162- (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
6.163- (if patch (list patch))))
6.164- last-line (mq-last-line))
6.165- (let ((lines (count-lines (point-min) (point-max))))
6.166- (if (or (<= lines 1)
6.167- (and (equal lines 2) (string-match "Now at:" last-line)))
6.168- (progn
6.169- (kill-buffer (current-buffer))
6.170- (delete-window))
6.171- (hg-view-mode prev-buf))))
6.172- (mq-refresh-buffers root)
6.173- (sit-for 0)
6.174- (when last-line
6.175- (if ok
6.176- (message "Pushing... %s" last-line)
6.177- (error "Pushing... %s" last-line)))))
6.178-
6.179-(defun mq-push-all ()
6.180- "Push patches until all are applied."
6.181- (interactive)
6.182- (mq-push "-a"))
6.183-
6.184-(defun mq-pop (&optional patch)
6.185- "Pop patches until PATCH is reached.
6.186-If PATCH is nil, pop at most one patch."
6.187- (interactive (list (mq-read-patch-name "qapplied" " to pop to"
6.188- current-prefix-arg)))
6.189- (let ((root (hg-root))
6.190- last-line ok)
6.191- (unless root
6.192- (error "Cannot pop outside a repository!"))
6.193- (hg-sync-buffers root)
6.194- (set-buffer (generate-new-buffer "qpop"))
6.195- (cd root)
6.196- (message "Popping...")
6.197- (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
6.198- (if patch (list patch))))
6.199- last-line (mq-last-line))
6.200- (kill-buffer (current-buffer))
6.201- (mq-refresh-buffers root)
6.202- (sit-for 0)
6.203- (when last-line
6.204- (if ok
6.205- (message "Popping... %s" last-line)
6.206- (error "Popping... %s" last-line)))))
6.207-
6.208-(defun mq-pop-all ()
6.209- "Push patches until none are applied."
6.210- (interactive)
6.211- (mq-pop "-a"))
6.212-
6.213-(defun mq-refresh-internal (root &rest args)
6.214- (hg-sync-buffers root)
6.215- (let ((patch (mq-patch-info "qtop")))
6.216- (message "Refreshing %s..." patch)
6.217- (let ((ret (apply 'hg-run "qrefresh" args)))
6.218- (if (equal (car ret) 0)
6.219- (message "Refreshing %s... done." patch)
6.220- (error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))
6.221-
6.222-(defun mq-refresh (&optional git)
6.223- "Refresh the topmost applied patch.
6.224-With a prefix argument, generate a git-compatible patch."
6.225- (interactive "P")
6.226- (let ((root (hg-root)))
6.227- (unless root
6.228- (error "Cannot refresh outside of a repository!"))
6.229- (apply 'mq-refresh-internal root (if git '("--git")))))
6.230-
6.231-(defun mq-patch-info (cmd &optional msg)
6.232- (let* ((ret (hg-run cmd))
6.233- (info (hg-chomp (cdr ret))))
6.234- (if (equal (car ret) 0)
6.235- (if msg
6.236- (message "%s patch: %s" msg info)
6.237- info)
6.238- (error "%s" info))))
6.239-
6.240-(defun mq-top ()
6.241- "Print the name of the topmost applied patch."
6.242- (interactive)
6.243- (mq-patch-info "qtop" "Top"))
6.244-
6.245-(defun mq-next ()
6.246- "Print the name of the next patch to be pushed."
6.247- (interactive)
6.248- (mq-patch-info "qnext" "Next"))
6.249-
6.250-(defun mq-previous ()
6.251- "Print the name of the first patch below the topmost applied patch.
6.252-This would become the active patch if popped to."
6.253- (interactive)
6.254- (mq-patch-info "qprev" "Previous"))
6.255-
6.256-(defun mq-edit-finish ()
6.257- "Finish editing the description of this patch, and refresh the patch."
6.258- (interactive)
6.259- (unless (equal (mq-patch-info "qtop") mq-top)
6.260- (error "Topmost patch has changed!"))
6.261- (hg-sync-buffers hg-root)
6.262- (run-hooks 'mq-edit-finish-hook)
6.263- (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
6.264- (let ((buf mq-prev-buffer))
6.265- (kill-buffer nil)
6.266- (switch-to-buffer buf)))
6.267-
6.268-(defun mq-edit-kill ()
6.269- "Kill the edit currently being prepared."
6.270- (interactive)
6.271- (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
6.272- (let ((buf mq-prev-buffer))
6.273- (kill-buffer nil)
6.274- (switch-to-buffer buf))))
6.275-
6.276-(defun mq-get-top (root)
6.277- (let ((entry (assoc root mq-top-patch)))
6.278- (if entry
6.279- (cdr entry))))
6.280-
6.281-(defun mq-set-top (root patch)
6.282- (let ((entry (assoc root mq-top-patch)))
6.283- (if entry
6.284- (if patch
6.285- (setcdr entry patch)
6.286- (setq mq-top-patch (delq entry mq-top-patch)))
6.287- (setq mq-top-patch (cons (cons root patch) mq-top-patch)))))
6.288-
6.289-(defun mq-update-mode-lines (root)
6.290- (let ((cwd default-directory))
6.291- (cd root)
6.292- (condition-case nil
6.293- (mq-set-top root (mq-patch-info "qtop"))
6.294- (error (mq-set-top root nil)))
6.295- (cd cwd))
6.296- (let ((patch (mq-get-top root)))
6.297- (save-excursion
6.298- (dolist (buf (hg-buffers-visiting-repo root))
6.299- (set-buffer buf)
6.300- (if mq-mode
6.301- (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ")))))))
6.302-
6.303-(defun mq-mode (&optional arg)
6.304- "Minor mode for Mercurial repositories with an MQ patch queue"
6.305- (interactive "i")
6.306- (cond ((hg-root)
6.307- (setq mq-mode (if (null arg) (not mq-mode)
6.308- arg))
6.309- (mq-update-mode-lines (hg-root))))
6.310- (run-hooks 'mq-mode-hook))
6.311-
6.312-(defun mq-edit-mode ()
6.313- "Mode for editing the description of a patch.
6.314-
6.315-Key bindings
6.316-------------
6.317-\\[mq-edit-finish] use this description
6.318-\\[mq-edit-kill] abandon this description"
6.319- (interactive)
6.320- (use-local-map mq-edit-mode-map)
6.321- (set-syntax-table text-mode-syntax-table)
6.322- (setq local-abbrev-table text-mode-abbrev-table
6.323- major-mode 'mq-edit-mode
6.324- mode-name "MQ-Edit")
6.325- (set-buffer-modified-p nil)
6.326- (setq buffer-undo-list nil)
6.327- (run-hooks 'text-mode-hook 'mq-edit-mode-hook))
6.328-
6.329-(defun mq-refresh-edit ()
6.330- "Refresh the topmost applied patch, editing the patch description."
6.331- (interactive)
6.332- (while mq-prev-buffer
6.333- (set-buffer mq-prev-buffer))
6.334- (let ((root (hg-root))
6.335- (prev-buffer (current-buffer))
6.336- (patch (mq-patch-info "qtop")))
6.337- (hg-sync-buffers root)
6.338- (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
6.339- (switch-to-buffer (get-buffer-create buf-name))
6.340- (when (= (point-min) (point-max))
6.341- (set (make-local-variable 'hg-root) root)
6.342- (set (make-local-variable 'mq-top) patch)
6.343- (setq mq-prev-buffer prev-buffer)
6.344- (insert (hg-run0 "qheader"))
6.345- (goto-char (point-min)))
6.346- (mq-edit-mode)
6.347- (cd root)))
6.348- (message "Type `C-c C-c' to finish editing and refresh the patch."))
6.349-
6.350-(defun mq-new (name)
6.351- "Create a new empty patch named NAME.
6.352-The patch is applied on top of the current topmost patch.
6.353-With a prefix argument, forcibly create the patch even if the working
6.354-directory is modified."
6.355- (interactive (list (mq-read-patch-name "qseries" " to create" t)))
6.356- (message "Creating patch...")
6.357- (let ((ret (if current-prefix-arg
6.358- (hg-run "qnew" "-f" name)
6.359- (hg-run "qnew" name))))
6.360- (if (equal (car ret) 0)
6.361- (progn
6.362- (hg-update-mode-lines (buffer-file-name))
6.363- (message "Creating patch... done."))
6.364- (error "Creating patch... %s" (hg-chomp (cdr ret))))))
6.365-
6.366-(defun mq-edit-series ()
6.367- "Edit the MQ series file directly."
6.368- (interactive)
6.369- (let ((root (hg-root)))
6.370- (unless root
6.371- (error "Not in an MQ repository!"))
6.372- (find-file (concat root ".hg/patches/series"))))
6.373-
6.374-(defun mq-diff (&optional git)
6.375- "Display a diff of the topmost applied patch.
6.376-With a prefix argument, display a git-compatible diff."
6.377- (interactive "P")
6.378- (hg-view-output ((format "MQ: Diff of %s" (mq-patch-info "qtop")))
6.379- (if git
6.380- (call-process (hg-binary) nil t nil "qdiff" "--git")
6.381- (call-process (hg-binary) nil t nil "qdiff"))
6.382- (diff-mode)
6.383- (font-lock-fontify-buffer)))
6.384-
6.385-(defun mq-signoff ()
6.386- "Sign off on the current patch, in the style used by the Linux kernel.
6.387-If the variable mq-signoff-address is non-nil, it will be used, otherwise
6.388-the value of the ui.username item from your hgrc will be used."
6.389- (interactive)
6.390- (let ((was-editing (eq major-mode 'mq-edit-mode))
6.391- signed)
6.392- (unless was-editing
6.393- (mq-refresh-edit))
6.394- (save-excursion
6.395- (let* ((user (or mq-signoff-address
6.396- (hg-run0 "debugconfig" "ui.username")))
6.397- (signoff (concat "Signed-off-by: " user)))
6.398- (if (search-forward signoff nil t)
6.399- (message "You have already signed off on this patch.")
6.400- (goto-char (point-max))
6.401- (let ((case-fold-search t))
6.402- (if (re-search-backward "^Signed-off-by: " nil t)
6.403- (forward-line 1)
6.404- (insert "\n")))
6.405- (insert signoff)
6.406- (message "%s" signoff)
6.407- (setq signed t))))
6.408- (unless was-editing
6.409- (if signed
6.410- (mq-edit-finish)
6.411- (mq-edit-kill)))))
6.412-
6.413-(provide 'mq)
7.1--- a/emacs/lib/ulang.el Sun Nov 26 16:43:15 2023 -0500
7.2+++ b/emacs/lib/ulang.el Sun Nov 26 22:11:45 2023 -0500
7.3@@ -25,7 +25,7 @@
7.4
7.5 ;;; Code:
7.6 (require 'org)
7.7-
7.8+(require 'ox)
7.9 (defvar ulang-links-history nil)
7.10 (defvar ulang-files-history nil)
7.11 ;;;###autoload
7.12@@ -40,7 +40,7 @@
7.13 (org-dynamic-block-define "links" 'ulang-dblock-insert-links)
7.14
7.15 (cl-pushnew '("header" .
7.16- "#+TITLE: $1
7.17+ "#+TITLE: $1
7.18 #+AUTHOR: $2
7.19 #+EMAIL: $3
7.20 #+DESCRIPTION: $4
8.1--- a/emacs/util.el Sun Nov 26 16:43:15 2023 -0500
8.2+++ b/emacs/util.el Sun Nov 26 22:11:45 2023 -0500
8.3@@ -158,9 +158,20 @@
8.4 ;;; Server
8.5 ;;;###autoload
8.6 (defun kill-emacs-restart (&optional arg)
8.7+ "Handler for SIGUSR1 signal, to (re)start an emacs server.
8.8+
8.9+Can be tested from within emacs with:
8.10+ (signal-process (emacs-pid) 'sigusr1)
8.11+
8.12+or from the command line with:
8.13+$ kill -USR1 <emacs-pid>
8.14+$ emacsclient -c
8.15+"
8.16 (interactive)
8.17- (kill-emacs arg t))
8.18+ (server-force-delete)
8.19+ (server-start))
8.20
8.21+(define-key special-event-map [sigusr1] 'kill-emacs-restart)
8.22
8.23 (provide 'util)
8.24 ;; util.el ends here
9.1--- a/lisp/std/fu.lisp Sun Nov 26 16:43:15 2023 -0500
9.2+++ b/lisp/std/fu.lisp Sun Nov 26 22:11:45 2023 -0500
9.3@@ -58,7 +58,8 @@
9.4 :maphash-keys
9.5 :hash-table-keys
9.6 :maphash-values
9.7- :hash-table-values))
9.8+ :hash-table-values
9.9+ :my-lisp-implementation))
9.10
9.11 (in-package :std/fu)
9.12
9.13@@ -1030,3 +1031,7 @@
9.14 (push v values))
9.15 table)
9.16 values))
9.17+
9.18+(defun my-lisp-implementation ()
9.19+ "Return the current lisp implemenation as a cons: (TYPE VERSION)"
9.20+ (cons (lisp-implementation-type) (lisp-implementation-version)))
