[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 01/01: Fix prefix of last merge and restore deleted files
|
From: |
Leo Liu |
|
Subject: |
[elpa] 01/01: Fix prefix of last merge and restore deleted files |
|
Date: |
Tue, 22 Apr 2014 08:40:41 +0000 |
leoliu pushed a commit to branch master
in repository elpa.
commit 3c1a6816100fb97f85cc07cac47f538e7a55ee73
Author: Leo Liu <address@hidden>
Date: Tue Apr 22 16:36:30 2014 +0800
Fix prefix of last merge and restore deleted files
See discussion
http://lists.gnu.org/archive/html/emacs-devel/2014-04/msg00311.html
---
admin/README.rst | 123 -----
admin/archive-contents.el | 588 ++++++++++++++++++++
admin/easy-kill.el | 832 -----------------------------
admin/forward-diffs.py | 432 +++++++++++++++
admin/org-synch.el | 22 +
admin/org-synch.sh | 15 +
admin/overmaint.txt | 12 +
admin/update-archive.sh | 106 ++++
{admin => packages/easy-kill}/.elpaignore | 0
{admin => packages/easy-kill}/.travis.yml | 0
{admin => packages/easy-kill}/Makefile | 0
packages/easy-kill/README.rst | 23 +-
packages/easy-kill/easy-kill.el | 317 ++++++++---
{admin => packages/easy-kill}/test.el | 0
14 files changed, 1430 insertions(+), 1040 deletions(-)
diff --git a/admin/README.rst b/admin/README.rst
deleted file mode 100644
index 02ad57b..0000000
--- a/admin/README.rst
+++ /dev/null
@@ -1,123 +0,0 @@
-====================================
- Kill & Mark Things Easily in Emacs
-====================================
-
-.. image:: https://travis-ci.org/leoliu/easy-kill.svg?branch=master
- :target: https://travis-ci.org/leoliu/easy-kill
- :align: right
- :alt: Travis CI build status
-
-Provide commands ``easy-kill`` and ``easy-mark`` to let users kill or
-mark things easily.
-
-Comments, bug reports and patches are highly appreciated.
-
-easy-kill
-~~~~~~~~~
-
-``easy-kill`` is a drop-in replacement for ``kill-ring-save``. To Use:
-::
-
- (global-set-key [remap kill-ring-save] 'easy-kill)
-
-After this configuration, ``M-w`` serves as both a command and a
-prefix key for other commands. ``M-w`` alone saves in the order of
-active region, url, email and finally current line (See
-``easy-kill-try-things``). As a prefix key:
-
-#. ``M-w w``: save word at point
-#. ``M-w s``: save sexp at point
-#. ``M-w l``: save list at point (enclosing sexp)
-#. ``M-w d``: save defun at point
-#. ``M-w f``: save file at point
-#. ``M-w b``: save ``buffer-file-name`` or ``default-directory``.
- ``-`` changes the kill to the directory name, ``+`` to full name
- and ``0`` to basename.
-
-The following keys modify the selection:
-
-#. address@hidden: append selection to previous kill and exit. For example,
- ``M-w d @`` will append current function to last kill.
-#. ``C-w``: kill selection and exit
-#. ``+``, ``-`` and ``1..9``: expand/shrink selection
-#. ``0`` shrink the selection to the intitial size i.e. before any
- expansion
-#. ``C-SPC``: turn selection into an active region
-#. ``C-g``: abort
-#. ``?``: help
-
-For example, ``M-w w`` saves current word, repeat ``w`` to expand the
-kill to include the next word. ``5`` to include the next 5 words etc.
-The other commands also follow this pattern.
-
-``+``/``-`` does expanding/shrinking according to the thing selected.
-So for ``word`` the expansion is word-wise, for ``line`` line-wise,
-for ``list`` or ``sexp``, list-wise.
-
-``list-wise`` expanding/shrinking work well in lispy modes (elisp,
-Common Lisp, Scheme, Clojure etc.), smie-based modes (Prolog, SML,
-Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Org mode, Nxml mode and
-Js2 mode.
-
-To copy the enclosing list in lispy modes, I used to do a lot of
-``C-M-u C-M-SPC M-w``. Now the key sequence is replaced by ``M-w l``
-(save list at point) as shown in `screenshot
-<http://i.imgur.com/8TNgPly.png>`_:
-
-.. figure:: http://i.imgur.com/8TNgPly.png
- :target: http://i.imgur.com/8TNgPly.png
- :alt: ``M-w l``
-
-easy-mark
-~~~~~~~~~
-
-``easy-mark`` is similar to ``easy-kill`` but marks the region
-immediately. It can be a handy replacement for ``mark-sexp`` allowing
-``+``/``-`` to do list-wise expanding/shrinking and marks the whole
-sexp even when in the middle of one. ::
-
- (global-set-key [remap mark-sexp] 'easy-mark)
-
-Install
-~~~~~~~
-
-``easy-kill`` is part of GNU ELPA and is also available on `MELPA
-<http://melpa.milkbox.net/#/easy-kill>`_.
-
-Extensions
-~~~~~~~~~~
-
-New things can be defined by following package ``thingatpt.el``'s
-convention, or by defining new functions named like
-``easy-kill-on-THING-NAME``. See ``easy-kill-on-buffer-file-name`` and
-``easy-kill-on-url`` for examples.
-
-NEWS
-~~~~
-
-0.9.3
-+++++
-
-#. Key ``?`` in ``easy-kill`` or ``easy-mark`` prints help info.
-#. ``M-w l`` can select the enclosing string.
-#. ``easy-mark`` learns exchanging point & mark.
-#. Key ``0`` now sets the selection to its initial size before any
- expansion.
-#. ``M-w l``, ``M-w s`` and list-wise ``+/-`` now work in Org mode.
-
-0.9.2
-+++++
-
-#. ``-`` can move pass the first selection.
-#. ``+``/``-`` on ``sexp`` no longer change ``thing`` to ``list``
-#. Mouse over the selection now shows description.
-#. Echo js2 node name.
-#. Append now uses sensible separator (customisable via
- ``easy-kill-alist``).
-#. The format of easy-kill-alist has changed. The old ``(CHAR .
- THING)`` format is still supported but may be removed in future.
-
-Bugs
-~~~~
-
-https://github.com/leoliu/easy-kill/issues
diff --git a/admin/archive-contents.el b/admin/archive-contents.el
new file mode 100644
index 0000000..241f1ad
--- /dev/null
+++ b/admin/archive-contents.el
@@ -0,0 +1,588 @@
+;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive. -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc
+
+;; Author: Stefan Monnier <address@hidden>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'lisp-mnt)
+(require 'package)
+(require 'pcase)
+
+(defconst archive-contents-subdirectory-regexp
+
"\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)")
+
+(defconst archive-re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
+ "Regular expression matching all files except \".\" and \"..\".")
+
+(defun archive--version-to-list (vers)
+ (when vers
+ (let ((l (version-to-list vers)))
+ ;; Signal an error for things like "1.02" which is parsed as "1.2".
+ (assert (equal vers (package-version-join l)) nil
+ "Unsupported version syntax %S" vers)
+ l)))
+
+(defun archive--convert-require (elt)
+ (list (car elt)
+ (archive--version-to-list (car (cdr elt)))))
+
+(defun archive--strip-rcs-id (str)
+ "Strip RCS version ID from the version string STR.
+If the result looks like a dotted numeric version, return it.
+Otherwise return nil."
+ (when str
+ (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ (condition-case nil
+ (if (archive--version-to-list str)
+ str)
+ (error str))))
+
+(defun archive--delete-elc-files (dir &optional only-orphans)
+ "Recursively delete all .elc files in DIR.
+Delete backup files also."
+ (dolist (f (directory-files dir t archive-re-no-dot))
+ (cond ((file-directory-p f)
+ (archive--delete-elc-files f))
+ ((or (and (string-match "\\.elc\\'" f)
+ (not (and only-orphans
+ (file-readable-p (replace-match ".el" t t f)))))
+ (backup-file-name-p f))
+ (delete-file f)))))
+
+(defun batch-make-archive ()
+ "Process package content directories and generate the archive-contents file."
+ (let ((packages '(1))) ; format-version.
+ (dolist (dir (directory-files default-directory nil archive-re-no-dot))
+ (condition-case v
+ (if (not (file-directory-p dir))
+ (message "Skipping non-package file %s" dir)
+ (let* ((pkg (file-name-nondirectory dir))
+ (autoloads-file (expand-file-name (concat pkg
"-autoloads.el") dir)))
+ ;; Omit autoloads and .elc files from the package.
+ (if (file-exists-p autoloads-file)
+ (delete-file autoloads-file))
+ (archive--delete-elc-files dir)
+ (let ((metadata (archive--metadata dir pkg)))
+ ;; (nth 1 metadata) is nil for "org" which is the only package
+ ;; still using the "org-pkg.el file to specify the metadata.
+ (if (and (nth 1 metadata)
+ (< (string-to-number (nth 1 metadata)) 0))
+ (progn ;; Negative version: don't publish this package yet!
+ (message "Package %s not released yet!" dir)
+ (delete-directory dir 'recursive))
+ (push (if (car metadata)
+ (apply #'archive--process-simple-package
+ dir pkg (cdr metadata))
+ (if (nth 1 metadata)
+ (apply #'archive--write-pkg-file
+ dir pkg (cdr metadata)))
+ (archive--process-multi-file-package dir pkg))
+ packages)))))
+ ((debug error) (error "Error in %s: %S" dir v))))
+ (with-temp-buffer
+ (pp (nreverse packages) (current-buffer))
+ (write-region nil nil "archive-contents"))))
+
+(defconst archive--revno-re "[0-9a-f]+")
+
+(defun archive-prepare-packages (srcdir)
+ "Prepare the `packages' directory inside the Git checkout.
+Expects to be called from within the `packages' directory.
+\"Prepare\" here is for subsequent construction of the packages and archive,
+so it is meant to refresh any generated files we may need.
+Currently only refreshes the ChangeLog files."
+ (setq srcdir (file-name-as-directory (expand-file-name srcdir)))
+ (let* ((wit ".changelog-witness")
+ (prevno (with-temp-buffer
+ (insert-file-contents wit)
+ (if (looking-at (concat archive--revno-re "$"))
+ (match-string 0)
+ (error "Can't find previous revision name"))))
+ (new-revno
+ (or (with-temp-buffer
+ (let ((default-directory srcdir))
+ (call-process "git" nil '(t) nil "rev-parse" "HEAD")
+ (goto-char (point-min))
+ (when (looking-at (concat archive--revno-re "$"))
+ (match-string 0))))
+ (error "Couldn't find the current revision's name")))
+ (pkgs '()))
+ (unless (equal prevno new-revno)
+ (with-temp-buffer
+ (let ((default-directory srcdir))
+ (unless (zerop (call-process "git" nil '(t) nil "diff"
+ "--dirstat=cumulative,0"
+ prevno))
+ (error "Error signaled by git diff --dirstat %d" prevno)))
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t.0-9%]* packages/\\([-[:alnum:]]+\\)/$"
+ nil t)
+ (push (match-string 1) pkgs))))
+ (let ((default-directory (expand-file-name "packages/")))
+ (dolist (pkg pkgs)
+ (condition-case v
+ (if (file-directory-p pkg)
+ (archive--make-changelog pkg (expand-file-name "packages/"
+ srcdir)))
+ (error (message "Error: %S" v)))))
+ (write-region new-revno nil wit nil 'quiet)
+ ;; Also update the ChangeLog of external packages.
+ (let ((default-directory (expand-file-name "packages/")))
+ (dolist (dir (directory-files "."))
+ (and (not (member dir '("." "..")))
+ (file-directory-p dir)
+ (let ((index (expand-file-name
+ (concat "packages/" dir "/.git/index")
+ srcdir))
+ (cl (expand-file-name "ChangeLog" dir)))
+ (and (file-exists-p index)
+ (or (not (file-exists-p cl))
+ (file-newer-than-file-p index cl))))
+ (archive--make-changelog
+ dir (expand-file-name "packages/" srcdir)))))
+ ))
+
+(defun archive--metadata (dir pkg)
+ "Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS),
+where SIMPLE is non-nil if the package is simple;
+VERSION is the version string of the simple package;
+DESCRIPTION is the brief description of the package;
+REQ is a list of requirements;
+EXTRAS is an alist with additional metadata.
+
+PKG is the name of the package and DIR is the directory where it is."
+ (let* ((mainfile (expand-file-name (concat pkg ".el") dir))
+ (files (directory-files dir nil "\\.el\\'")))
+ (setq files (delete (concat pkg "-pkg.el") files))
+ (setq files (delete (concat pkg "-autoloads.el") files))
+ (cond
+ ((file-exists-p mainfile)
+ (with-temp-buffer
+ (insert-file-contents mainfile)
+ (goto-char (point-min))
+ (if (not (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[
\t]*\\)?$"))
+ (error "Can't parse first line of %s" mainfile)
+ ;; Grab the other fields, which are not mandatory.
+ (let* ((description (match-string 1))
+ (version
+ (or (archive--strip-rcs-id (lm-header "package-version"))
+ (archive--strip-rcs-id (lm-header "version"))
+ (unless (equal pkg "org")
+ (error "Missing `version' header"))))
+ (requires-str (lm-header "package-requires"))
+ (pt (lm-header "package-type"))
+ (simple (if pt (equal pt "simple") (= (length files) 1)))
+ (keywords (lm-keywords-list))
+ (url (or (lm-header "url")
+ (format "http://elpa.gnu.org/packages/%s.html"; pkg)))
+ (req
+ (if requires-str
+ (mapcar 'archive--convert-require
+ (car (read-from-string requires-str))))))
+ (list simple version description req
+ ;; extra parameters
+ (list (cons :url url)
+ (cons :keywords keywords)))))))
+ (t
+ (error "Can find main file %s file in %s" mainfile dir)))))
+
+(defun archive--process-simple-package (dir pkg vers desc req extras)
+ "Deploy the contents of DIR into the archive as a simple package.
+Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor."
+ ;; Write DIR/foo.el to foo-VERS.el and delete DIR
+ (rename-file (expand-file-name (concat pkg ".el") dir)
+ (concat pkg "-" vers ".el"))
+ ;; Add the content of the ChangeLog.
+ (let ((cl (expand-file-name "ChangeLog" dir)))
+ (with-current-buffer (find-file-noselect (concat pkg "-" vers ".el"))
+ (goto-char (point-max))
+ (re-search-backward "^;;;.*ends here")
+ (re-search-backward "^(provide")
+ (skip-chars-backward " \t\n")
+ (insert "\n\n;;;; ChangeLog:\n\n")
+ (let* ((start (point))
+ (end (copy-marker start t)))
+ (condition-case nil
+ (insert-file-contents cl)
+ (file-error (message "Can't find %S's ChangeLog file" pkg)))
+ (goto-char end)
+ (unless (bolp) (insert "\n"))
+ (while (progn (forward-line -1) (>= (point) start))
+ (insert ";; ")))
+ (set (make-local-variable 'backup-inhibited) t)
+ (basic-save-buffer) ;Less chatty than save-buffer.
+ (kill-buffer)))
+ (delete-directory dir t)
+ (cons (intern pkg) (vector (archive--version-to-list vers)
+ req desc 'single extras)))
+
+(defun archive--make-changelog (dir srcdir)
+ "Export Git log info of DIR into a ChangeLog file."
+ (message "Refreshing ChangeLog in %S" dir)
+ (let ((default-directory (file-name-as-directory (expand-file-name dir))))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (if (file-readable-p "ChangeLog") (insert-file-contents "ChangeLog"))
+ (let ((old-md5 (md5 (current-buffer))))
+ (erase-buffer)
+ (let ((default-directory
+ (file-name-as-directory (expand-file-name dir srcdir))))
+ (call-process "git" nil (current-buffer) nil
+ "log" "--date=short"
+ "--format=%cd %aN <%ae>%n%n%w(80,8,8)%B%n"
+ "."))
+ (tabify (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "\n\n\n+" nil t)
+ (replace-match "\n\n"))
+ (if (equal old-md5 (md5 (current-buffer)))
+ (message "ChangeLog's md5 unchanged for %S" dir)
+ (write-region (point-min) (point-max) "ChangeLog" nil 'quiet)))))))
+
+(defun archive--alist-to-plist-args (alist)
+ (mapcar (lambda (x)
+ (if (and (not (consp x))
+ (or (keywordp x)
+ (not (symbolp x))
+ (memq x '(nil t))))
+ x `',x))
+ (apply #'nconc
+ (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
+
+(defun archive--plist-args-to-alist (plist)
+ (let (alist)
+ (while plist
+ (let ((value (cadr plist)))
+ (when value
+ (cl-assert (keywordp (car plist)))
+ (push (cons (car plist)
+ (if (eq 'quote (car-safe value)) (cadr value) value))
+ alist)))
+ (setq plist (cddr plist)))
+ alist))
+
+(defun archive--process-multi-file-package (dir pkg)
+ "Deploy the contents of DIR into the archive as a multi-file package.
+Rename DIR/ to PKG-VERS/, and return the descriptor."
+ (let* ((exp (archive--multi-file-package-def dir pkg))
+ (vers (nth 2 exp))
+ (req-exp (nth 4 exp))
+ (req (mapcar 'archive--convert-require
+ (if (eq 'quote (car-safe req-exp)) (nth 1 req-exp)
+ (when req-exp
+ (error "REQ should be a quoted constant: %S"
+ req-exp)))))
+ (extras (archive--plist-args-to-alist (nthcdr 5 exp))))
+ (unless (equal (nth 1 exp) pkg)
+ (error (format "Package name %s doesn't match file name %s"
+ (nth 1 exp) pkg)))
+ (rename-file dir (concat pkg "-" vers))
+ (cons (intern pkg) (vector (archive--version-to-list vers)
+ req (nth 3 exp) 'tar extras))))
+
+(defun archive--multi-file-package-def (dir pkg)
+ "Return the `define-package' form in the file DIR/PKG-pkg.el."
+ (let ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir)))
+ (with-temp-buffer
+ (unless (file-exists-p pkg-file)
+ (error "File not found: %s" pkg-file))
+ (insert-file-contents pkg-file)
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+(defun archive--refresh-pkg-file ()
+ (let* ((dir (directory-file-name default-directory))
+ (pkg (file-name-nondirectory dir)))
+ (apply #'archive--write-pkg-file dir pkg
+ (cdr (archive--metadata dir pkg)))))
+
+(defun archive--write-pkg-file (pkg-dir name version desc requires extras)
+ (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
+ (print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat (format ";; Generated package description from %s.el\n"
+ name)
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ name
+ version
+ desc
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires)))
+ (archive--alist-to-plist-args extras)))
+ "\n")
+ nil
+ pkg-file)))
+
+;;; Make the HTML pages for online browsing.
+
+(defun archive--html-header (title)
+ (format "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">
+<html>
+<head>
+ <title>%s</title>
+ <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
+</head>
+<body>
+<h1 align=\"center\">%s</h1>\n"
+ title title))
+
+(defun archive--html-bytes-format (bytes) ;Aka memory-usage-format.
+ (setq bytes (/ bytes 1024.0))
+ (let ((units '(;; "B"
+ "kB" "MB" "GB" "TB")))
+ (while (>= bytes 1024)
+ (setq bytes (/ bytes 1024.0))
+ (setq units (cdr units)))
+ (cond
+ ;; ((integerp bytes) (format "%4d%s" bytes (car units)))
+ ((>= bytes 100) (format "%4.0f%s" bytes (car units)))
+ ((>= bytes 10) (format "%4.1f%s" bytes (car units)))
+ (t (format "%4.2f%s" bytes (car units))))))
+
+(defun archive--get-prop (prop name srcdir mainsrcfile)
+ (let ((kprop (intern (format ":%s" (downcase prop)))))
+ (or
+ (let ((pkgdescfile (expand-file-name (format "%s-pkg.el" name)
+ srcdir)))
+ (when (file-readable-p pkgdescfile)
+ (with-temp-buffer
+ (insert-file-contents pkgdescfile)
+ (let ((desc (read (current-buffer))))
+ (plist-get (cdr desc) kprop)))))
+ (when (file-readable-p mainsrcfile)
+ (with-temp-buffer
+ (insert-file-contents mainsrcfile)
+ (lm-header prop))))))
+
+(defun archive--get-section (hsection fsection srcdir mainsrcfile)
+ (when (consp fsection)
+ (while (cdr-safe fsection)
+ (setq fsection
+ (if (file-readable-p (expand-file-name (car fsection) srcdir))
+ (car fsection)
+ (cdr fsection))))
+ (when (consp fsection) (setq fsection (car fsection))))
+ (cond
+ ((file-readable-p (expand-file-name fsection srcdir))
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name fsection srcdir))
+ (buffer-string)))
+ ((file-readable-p mainsrcfile)
+ (with-temp-buffer
+ (insert-file-contents mainsrcfile)
+ (let ((start (lm-section-start hsection)))
+ (when start
+ (insert
+ (prog1
+ (buffer-substring start (lm-section-end hsection))
+ (erase-buffer)))
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (delete-region (point) (line-beginning-position 2))
+ (uncomment-region (point-min) (point-max))
+ (when (looking-at "^\\([ \t]*\n\\)+")
+ (replace-match ""))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (delete-region (point) (point-max))
+ (buffer-string)))))))
+
+(defun archive--quote (txt)
+ (replace-regexp-in-string "<" "<"
+ (replace-regexp-in-string "&" "&" txt)))
+
+(defun archive--insert-repolinks (name srcdir mainsrcfile url)
+ (if url
+ (insert (format "<p>Origin: <a href=%S>%s</a></p>\n"
+ url (archive--quote url)))
+ (let* ((externals
+ (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name "../../../elpa/externals-list" srcdir))
+ (read (current-buffer))))
+ (external (eq :external (nth 1 (assoc name externals))))
+ (git-sv "http://git.savannah.gnu.org/";)
+ (urls (if external
+ '("cgit/emacs/elpa.git/?h=externals/"
+
"gitweb/?p=emacs/elpa.git;a=shortlog;h=refs/heads/externals/")
+ '("cgit/emacs/elpa.git/tree/packages/"
+ "gitweb/?p=emacs/elpa.git;a=tree;f=packages/"))))
+ (insert (format
+ (concat "<p>Browse repository: <a href=%S>%s</a>"
+ " or <a href=%S>%s</a></p>\n")
+ (concat git-sv (nth 0 urls) name)
+ 'CGit
+ (concat git-sv (nth 1 urls) name)
+ 'Gitweb)))))
+
+(defun archive--html-make-pkg (pkg files)
+ (let* ((name (symbol-name (car pkg)))
+ (latest (package-version-join (aref (cdr pkg) 0)))
+ (srcdir (expand-file-name name "../../build/packages"))
+ (mainsrcfile (expand-file-name (format "%s.el" name) srcdir))
+ (desc (aref (cdr pkg) 2)))
+ (with-temp-buffer
+ (insert (archive--html-header (format "GNU ELPA - %s" name)))
+ (insert (format "<p>Description: %s</p>\n" (archive--quote desc)))
+ (let* ((file (cdr (assoc latest files)))
+ (attrs (file-attributes file)))
+ (insert (format "<p>Latest: <a href=%S>%s</a>, %s, %s</p>\n"
+ file (archive--quote file)
+ (format-time-string "%Y-%b-%d" (nth 5 attrs))
+ (archive--html-bytes-format (nth 7 attrs)))))
+ (let ((maint (archive--get-prop "Maintainer" name srcdir mainsrcfile)))
+ (when maint
+ (insert (format "<p>Maintainer: %s</p>\n" (archive--quote maint)))))
+ (archive--insert-repolinks name srcdir mainsrcfile
+ (cdr (assoc :url (aref (cdr pkg) 4))))
+ (let ((rm (archive--get-section
+ "Commentary" '("README" "README.rst"
+ ;; Most README.md files seem to be currently
+ ;; worse than the Commentary: section :-(
+ ;; "README.md"
+ "README.org")
+ srcdir mainsrcfile)))
+ (when rm
+ (write-region rm nil (concat name "-readme.txt"))
+ (insert "<h2>Full description</h2><pre>\n" (archive--quote rm)
+ "\n</pre>\n")))
+ (unless (< (length files) 2)
+ (insert (format "<h2>Old versions</h2><table cellpadding=\"3\"
border=\"1\">\n"))
+ (dolist (file files)
+ (unless (equal (pop file) latest)
+ (let ((attrs (file-attributes file)))
+ (insert (format "<tr><td><a
href=%S>%s</a></td><td>%s</td><td>%s</td>\n"
+ file (archive--quote file)
+ (format-time-string "%Y-%b-%d" (nth 5 attrs))
+ (archive--html-bytes-format (nth 7 attrs)))))))
+ (insert "</table>\n"))
+ (let ((news (archive--get-section
+ "News" '("NEWS" "NEWS.rst" "NEWS.md" "NEWS.org")
+ srcdir mainsrcfile)))
+ (when news
+ (insert "<h2>News</h2><pre>\n" (archive--quote news) "\n</pre>\n")))
+ (insert "</body>\n")
+ (write-region (point-min) (point-max) (concat name ".html")))))
+
+(defun archive--html-make-index (pkgs)
+ (with-temp-buffer
+ (insert (archive--html-header "GNU ELPA Packages"))
+ (insert "<table cellpadding=\"3\" border=\"1\">\n")
+ (insert "<tr><th>Package</th><th>Version</th><th>Description</th></tr>\n")
+ (dolist (pkg pkgs)
+ (insert (format "<tr><td><a
href=\"%s.html\">%s</a></td><td>%s</td><td>%s</td></tr>\n"
+ (car pkg) (car pkg)
+ (package-version-join (aref (cdr pkg) 0))
+ (aref (cdr pkg) 2))))
+ (insert "</table></body>\n")
+ (write-region (point-min) (point-max) "index.html")))
+
+(defun batch-html-make-index ()
+ (let ((packages (make-hash-table :test #'equal))
+ (archive-contents
+ (with-temp-buffer
+ (insert-file-contents "archive-contents")
+ (goto-char (point-min))
+ ;; Skip the first element which is a version number.
+ (cdr (read (current-buffer))))))
+ (dolist (file (directory-files default-directory nil))
+ (cond
+ ((member file '("." ".." "elpa.rss" "index.html" "archive-contents")))
+ ((string-match "\\.html\\'" file))
+ ((string-match "-readme\\.txt\\'" file)
+ (let ((name (substring file 0 (match-beginning 0))))
+ (puthash name (gethash name packages) packages)))
+ ((string-match "-\\([0-9][^-]*\\)\\.\\(tar\\|el\\)\\'" file)
+ (let ((name (substring file 0 (match-beginning 0)))
+ (version (match-string 1 file)))
+ (push (cons version file) (gethash name packages))))
+ (t (message "Unknown file %S" file))))
+ (dolist (pkg archive-contents)
+ (archive--html-make-pkg pkg (gethash (symbol-name (car pkg)) packages)))
+ ;; FIXME: Add (old?) packages that are in `packages' but not in
+ ;; archive-contents.
+ (archive--html-make-index archive-contents)))
+
+;;; Maintain external packages.
+
+(defconst archive--elpa-git-url "git://git.sv.gnu.org/emacs/elpa")
+
+(defun archive-add/remove/update-externals ()
+ (let ((exts (with-current-buffer (find-file-noselect "externals-list")
+ (goto-char (point-min))
+ (read (current-buffer)))))
+ (let ((default-directory (expand-file-name "packages/")))
+ ;; Remove "old/odd" externals.
+ (dolist (dir (directory-files "."))
+ (cond
+ ((member dir '("." "..")) nil)
+ ((assoc dir exts) nil)
+ ((file-directory-p (expand-file-name (format "%s/.git" dir)))
+ (let ((status
+ (with-temp-buffer
+ (let ((default-directory (file-name-as-directory
+ (expand-file-name dir))))
+ (call-process "git" nil t nil "status" "--porcelain")
+ (buffer-string)))))
+ (if (zerop (length status))
+ (progn (delete-directory dir 'recursive t)
+ (message "Deleted all of %s" dir))
+ (message "Keeping leftover unclean %s:\n%s" dir status))))))
+ (pcase-dolist (`(,dir ,kind ,_url) exts)
+ (cond
+ ((eq kind :subtree) nil) ;Nothing to do.
+ ((not (eq kind :external))
+ (message "Unknown external package kind `%S' for %s" kind dir))
+ ((not (file-exists-p dir))
+ (let* ((branch (concat "externals/" dir))
+ (output
+ (with-temp-buffer
+ ;; FIXME: Use git-new-workdir!
+ (call-process "git" nil t nil "clone"
+ "--reference" ".." "--branch" branch
+ archive--elpa-git-url dir)
+ (buffer-string))))
+ (message "Cloning branch %s:\n%s" dir output)))
+ ((not (file-directory-p (concat dir "/.git")))
+ (message "%s is in the way of an external, please remove!" dir))
+ (t
+ (let ((default-directory (file-name-as-directory
+ (expand-file-name dir))))
+ (with-temp-buffer
+ (message "Running git pull in %S" default-directory)
+ (call-process "git" nil t nil "pull")
+ (message "Updated %s:%s" dir (buffer-string))))
+ ))))))
+
+(provide 'archive-contents)
+;;; archive-contents.el ends here
diff --git a/admin/easy-kill.el b/admin/easy-kill.el
deleted file mode 100644
index 5db6823..0000000
--- a/admin/easy-kill.el
+++ /dev/null
@@ -1,832 +0,0 @@
-;;; easy-kill.el --- kill & mark things easily -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <address@hidden>
-;; Version: 0.9.3
-;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
-;; Keywords: killing, convenience
-;; Created: 2013-08-12
-;; URL: https://github.com/leoliu/easy-kill
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `easy-kill' aims to be a drop-in replacement for `kill-ring-save'.
-;;
-;; To use: (global-set-key [remap kill-ring-save] 'easy-kill)
-
-;; `easy-mark' is similar to `easy-kill' but marks the region
-;; immediately. It can be a handy replacement for `mark-sexp' allowing
-;; `+'/`-' to do list-wise expanding/shrinking.
-;;
-;; To use: (global-set-key [remap mark-sexp] 'easy-mark)
-
-;; Please send bug reports or feature requests to:
-;; https://github.com/leoliu/easy-kill/issues
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'thingatpt)
-(eval-when-compile (require 'cl)) ;For `defsetf'.
-
-(eval-and-compile
- (cond
- ((fboundp 'set-transient-map) nil)
- ((fboundp 'set-temporary-overlay-map) ; new in 24.3
- (defalias 'set-transient-map 'set-temporary-overlay-map))
- (t
- (defun set-transient-map (map &optional keep-pred)
- (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
- (overlaysym (make-symbol "t"))
- (alist (list (cons overlaysym map)))
- (clearfun
- `(lambda ()
- (unless ,(cond ((null keep-pred) nil)
- ((eq t keep-pred)
- `(eq this-command
- (lookup-key ',map
- (this-command-keys-vector))))
- (t `(funcall ',keep-pred)))
- (set ',overlaysym nil) ;Just in case.
- (remove-hook 'pre-command-hook ',clearfunsym)
- (setq emulation-mode-map-alists
- (delq ',alist emulation-mode-map-alists))))))
- (set overlaysym overlaysym)
- (fset clearfunsym clearfun)
- (add-hook 'pre-command-hook clearfunsym)
- (push alist emulation-mode-map-alists))))))
-
-(defcustom easy-kill-alist '((?w word " ")
- (?s sexp "\n")
- (?l list "\n")
- (?f filename "\n")
- (?d defun "\n\n")
- (?e line "\n")
- (?b buffer-file-name))
- "A list of (CHAR THING APPEND).
-CHAR is used immediately following `easy-kill' to select THING.
-APPEND is optional and if non-nil specifies the separator (a
-string) for appending current selection to previous kill.
-
-Note: each element can also be (CHAR . THING) but this is
-deprecated."
- :type '(repeat (list character symbol
- (choice string (const :tag "None" nil))))
- :group 'killing)
-
-(defcustom easy-kill-try-things '(url email line)
- "A list of things for `easy-kill' to try."
- :type '(repeat symbol)
- :group 'killing)
-
-(defcustom easy-mark-try-things '(url email sexp)
- "A list of things for `easy-mark' to try."
- :type '(repeat symbol)
- :group 'killing)
-
-(defface easy-kill-selection '((t (:inherit secondary-selection)))
- "Faced used to highlight kill candidate."
- :group 'killing)
-
-(defface easy-kill-origin '((t (:inverse-video t :inherit error)))
- "Faced used to highlight the origin."
- :group 'killing)
-
-(defvar easy-kill-base-map
- (let ((map (make-sparse-keymap)))
- (define-key map "-" 'easy-kill-shrink)
- (define-key map "+" 'easy-kill-expand)
- (define-key map "=" 'easy-kill-expand)
- (define-key map "@" 'easy-kill-append)
- ;; Note: didn't pick C-h because it is a very useful prefix key.
- (define-key map "?" 'easy-kill-help)
- (define-key map [remap set-mark-command] 'easy-kill-mark-region)
- (define-key map [remap kill-region] 'easy-kill-region)
- (define-key map [remap keyboard-quit] 'easy-kill-abort)
- (define-key map [remap exchange-point-and-mark]
- 'easy-kill-exchange-point-and-mark)
- (mapc (lambda (d)
- (define-key map (number-to-string d) 'easy-kill-digit-argument))
- (number-sequence 0 9))
- map))
-
-(defvar easy-kill-inhibit-message nil)
-
-(defun easy-kill-echo (format-string &rest args)
- "Same as `message' except not writing to *Messages* buffer.
-Do nothing if `easy-kill-inhibit-message' is non-nil."
- (unless easy-kill-inhibit-message
- (let (message-log-max)
- (apply 'message format-string args))))
-
-(defun easy-kill-trim (s &optional how)
- (let ((wchars "[ \t\n\r\f\v]*"))
- (pcase how
- (`left (and (string-match (concat "\\`" wchars) s)
- (substring s (match-end 0))))
- (`right (substring s 0 (string-match-p (concat wchars "\\'") s)))
- (_ (easy-kill-trim (easy-kill-trim s 'left) 'right)))))
-
-(defun easy-kill-mode-sname (m)
- (cl-check-type m (and (or symbol string) (not boolean)))
- (cl-etypecase m
- (symbol (easy-kill-mode-sname (symbol-name m)))
- (string (substring m 0 (string-match-p "\\(?:-minor\\)?-mode\\'" m)))))
-
-(defun easy-kill-fboundp (name)
- "Like `fboundp' but NAME can be string or symbol.
-The value is the function's symbol if non-nil."
- (cl-etypecase name
- (string (easy-kill-fboundp (intern-soft name)))
- (symbol (and (fboundp name) name))))
-
-(defun easy-kill-pair-to-list (pair)
- (pcase pair
- (`nil nil)
- (`(,beg . ,end) (list beg end))
- (_ (signal 'wrong-type-argument (list pair "Not a dot pair")))))
-
-(defun easy-kill-interprogram-cut (text)
- "Make non-empty TEXT available to other programs."
- (cl-check-type text string)
- (and interprogram-cut-function
- (not (equal text ""))
- (funcall interprogram-cut-function text)))
-
-(defun easy-kill-map ()
- "Build the keymap according to `easy-kill-alist'."
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map easy-kill-base-map)
- (mapc (lambda (c)
- ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select)
- (define-key map (char-to-string c) 'easy-kill-thing))
- (mapcar 'car easy-kill-alist))
- map))
-
-(defun easy-kill--fmt (x y &optional z)
- (cl-etypecase x
- (character (easy-kill--fmt
- (single-key-description x)
- (symbol-name y)
- (and z (let ((print-escape-newlines t))
- (prin1-to-string z)))))
- (string (with-output-to-string
- (princ x)
- (princ (make-string (- 16 (mod (length x) 16)) ?\s))
- (princ y)
- (when z
- (princ (make-string (- 16 (mod (length y) 16)) ?\s))
- (princ z))))))
-
-(defun easy-kill-help ()
- (interactive)
- (help-setup-xref '(easy-kill-help) (called-interactively-p 'any))
- (with-help-window (help-buffer)
- (princ (concat (make-string 15 ?=) " "))
- (princ "Easy Kill/Mark Key Bindings ")
- (princ (concat (make-string 15 ?=) "\n\n"))
- (princ (easy-kill--fmt "Key" "Thing" "Separator"))
- (princ "\n")
- (princ (easy-kill--fmt "---" "-----" "---------"))
- (princ "\n\n")
- (princ (mapconcat (lambda (x) (pcase x
- (`(,c ,thing ,sep)
- (easy-kill--fmt c thing sep))
- ((or `(,c ,thing) `(,c . ,thing))
- (easy-kill--fmt c thing))))
- easy-kill-alist "\n"))
- (princ "\n\n")
- (princ (substitute-command-keys "\\{easy-kill-base-map}"))))
-
-(defvar easy-kill-candidate nil)
-
-(defun easy-kill--bounds ()
- (cons (overlay-start easy-kill-candidate)
- (overlay-end easy-kill-candidate)))
-
-;;; Note: gv-define-setter not available in 24.1 and 24.2
-;; (gv-define-setter easy-kill--bounds (val)
-;; (macroexp-let2 macroexp-copyable-p v val
-;; `(move-overlay easy-kill-candidate (car ,v) (cdr ,v))))
-
-(defsetf easy-kill--bounds () (v)
- `(let ((tmp ,v))
- (move-overlay easy-kill-candidate (car tmp) (cdr tmp))))
-
-(defmacro easy-kill-get (prop)
- "Get the value of the kill candidate's property PROP.
-Use `setf' to change property value."
- (pcase prop
- (`start '(overlay-start easy-kill-candidate))
- (`end '(overlay-end easy-kill-candidate))
- (`bounds '(easy-kill--bounds))
- (`buffer '(overlay-buffer easy-kill-candidate))
- (`properties '(append (list 'start (easy-kill-get start))
- (list 'end (easy-kill-get end))
- (list 'buffer (easy-kill-get buffer))
- (overlay-properties easy-kill-candidate)))
- (_ `(overlay-get easy-kill-candidate ',prop))))
-
-(defun easy-kill-init-candidate (n &optional mark)
- ;; Manipulate `easy-kill-candidate' directly during initialisation;
- ;; should use `easy-kill-get' elsewhere.
- (let ((o (make-overlay (point) (point))))
- (unless mark
- (overlay-put o 'face 'easy-kill-selection))
- (overlay-put o 'origin (point))
- (overlay-put o 'help-echo #'easy-kill-describe-candidate)
- ;; Use higher priority to avoid shadowing by, for example,
- ;; `hl-line-mode'.
- (overlay-put o 'priority 999)
- (when mark
- (overlay-put o 'mark 'start)
- (let ((i (make-overlay (point) (point))))
- (overlay-put i 'priority (1+ (overlay-get o 'priority)))
- (overlay-put i 'face 'easy-kill-origin)
- (overlay-put i 'as (propertize " " 'face 'easy-kill-origin))
- (overlay-put o 'origin-indicator i)))
- (setq easy-kill-candidate o)
- (save-restriction
- ;; Work around http://debbugs.gnu.org/15808; not needed in 24.4.
- (narrow-to-region (max (point-min) (- (point) 1000))
- (min (point-max) (+ (point) 1000)))
- (let ((easy-kill-inhibit-message t))
- (cl-dolist (thing easy-kill-try-things)
- (easy-kill-thing thing n)
- (or (string= (easy-kill-candidate) "")
- (cl-return)))))
- o))
-
-(defun easy-kill-indicate-origin ()
- (let ((i (easy-kill-get origin-indicator))
- (origin (easy-kill-get origin)))
- (cond
- ((not (overlayp i)) nil)
- ((= origin (point))
- (overlay-put i 'after-string nil))
- ((memq (char-after origin) '(?\t ?\n))
- (overlay-put i 'after-string (overlay-get i 'as)))
- (t (move-overlay i origin (1+ origin))
- (overlay-put i 'after-string nil)))))
-
-(defun easy-kill-candidate ()
- "Get the kill candidate as a string.
-If the overlay specified by variable `easy-kill-candidate' has
-non-zero length, it is the string covered by the overlay.
-Otherwise, it is the value of the overlay's candidate property."
- (with-current-buffer (easy-kill-get buffer)
- (or (pcase (easy-kill-get bounds)
- (`(,_x . ,_x) (easy-kill-get candidate))
- (`(,beg . ,end) (filter-buffer-substring beg end)))
- "")))
-
-(defun easy-kill-describe-candidate (&rest _)
- "Return a string that describes current kill candidate."
- (let* ((props (cl-loop for k in '(thing start end origin)
- with all = (easy-kill-get properties)
- ;; Allow describe-PROP to provide customised
- ;; description.
- for dk = (intern-soft (format "describe-%s" k))
- for dv = (and dk (plist-get all dk))
- for v = (or (if (functionp dv) (funcall dv) dv)
- (plist-get all k))
- when v collect (format "%s:\t%s" k v)))
- (txt (mapconcat #'identity props "\n")))
- (format "cmd:\t%s\n%s"
- (if (easy-kill-get mark) "easy-mark" "easy-kill")
- txt)))
-
-(defun easy-kill-adjust-candidate (thing &optional beg end)
- "Adjust kill candidate to THING, BEG, END.
-If BEG is a string, shrink the overlay to zero length and set its
-candidate property instead."
- (setf (easy-kill-get thing) thing)
- (cond ((stringp beg)
- (setf (easy-kill-get bounds) (cons (point) (point)))
- (setf (easy-kill-get candidate) beg)
- (let ((easy-kill-inhibit-message nil))
- (easy-kill-echo "%s" beg)))
- (t
- (setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start))
- (or end (easy-kill-get end))))))
- (cond ((easy-kill-get mark)
- (easy-kill-mark-region)
- (easy-kill-indicate-origin))
- (t
- (easy-kill-interprogram-cut (easy-kill-candidate)))))
-
-(defun easy-kill-save-candidate ()
- (unless (string= (easy-kill-candidate) "")
- ;; Don't modify the clipboard here since it is called in
- ;; `pre-command-hook' per `easy-kill-activate-keymap' and will
- ;; confuse `yank' if it is current command. Also
- ;; `easy-kill-adjust-candidate' already did that.
- (let ((interprogram-cut-function nil)
- (interprogram-paste-function nil))
- (kill-new (if (and (easy-kill-get append) kill-ring)
- (cl-labels ((join (x sep y)
- (if sep (concat (easy-kill-trim x 'right)
- sep
- (easy-kill-trim y 'left))
- (concat x y))))
- (join (car kill-ring)
- (nth 2 (cl-rassoc (easy-kill-get thing)
- easy-kill-alist :key #'car))
- (easy-kill-candidate)))
- (easy-kill-candidate))
- (easy-kill-get append)))
- t))
-
-(defun easy-kill-destroy-candidate ()
- (let ((hook (make-symbol "easy-kill-destroy-candidate")))
- (fset hook `(lambda ()
- (let ((o ,easy-kill-candidate))
- (when o
- (let ((i (overlay-get o 'origin-indicator)))
- (and (overlayp i) (delete-overlay i)))
- (delete-overlay o)))
- (remove-hook 'post-command-hook ',hook)))
- ;; Run in `post-command-hook' so that exit commands can still use
- ;; `easy-kill-candidate'.
- (add-hook 'post-command-hook hook)))
-
-(defun easy-kill-expand ()
- (interactive)
- (easy-kill-thing nil '+))
-
-(defun easy-kill-digit-argument (n)
- "Expand selection by N number of things.
-If N is 0 shrink the selection to the initial size before any
-expansion."
- (interactive
- (list (- (logand (if (integerp last-command-event)
- last-command-event
- (get last-command-event 'ascii-character))
- ?\177)
- ?0)))
- (easy-kill-thing nil n))
-
-(defun easy-kill-shrink ()
- (interactive)
- (easy-kill-thing nil '-))
-
-(defun easy-kill-thing-handler (base mode)
- "Get the handler for MODE or nil if none is defined.
-For example, if BASE is \"easy-kill-on-list\" and MODE is
-nxml-mode `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are
-checked in order. The former is never defined in this package and
-is safe for users to customise. If neither is defined continue
-checking on the parent mode. Finally `easy-kill-on-list' is
-checked."
- (or (and mode (or (easy-kill-fboundp
- (concat (easy-kill-mode-sname mode) ":" base))
- (easy-kill-fboundp
- (concat base ":" (easy-kill-mode-sname mode)))))
- (let ((parent (get mode 'derived-mode-parent)))
- (and parent (easy-kill-thing-handler base parent)))
- (easy-kill-fboundp base)))
-
-(defun easy-kill-bounds-of-thing-at-point (thing)
- "Easy Kill wrapper for `bounds-of-thing-at-point'."
- (pcase (easy-kill-thing-handler
- (format "easy-kill-bounds-of-%s-at-point" thing)
- major-mode)
- ((and (pred functionp) fn) (funcall fn))
- (_ (bounds-of-thing-at-point thing))))
-
-(defun easy-kill-thing-forward-1 (thing &optional n)
- "Easy Kill wrapper for `forward-thing'."
- (pcase (easy-kill-thing-handler
- (format "easy-kill-thing-forward-%s" thing)
- major-mode)
- ((and (pred functionp) fn) (funcall fn n))
- (_ (forward-thing thing n))))
-
-;; Helper for `easy-kill-thing'.
-(defun easy-kill-thing-forward (n)
- (when (and (easy-kill-get thing) (/= n 0))
- (let* ((step (if (cl-minusp n) -1 +1))
- (thing (easy-kill-get thing))
- (bounds1 (or (easy-kill-pair-to-list
- (easy-kill-bounds-of-thing-at-point thing))
- (list (point) (point))))
- (start (easy-kill-get start))
- (end (easy-kill-get end))
- (front (or (car (cl-set-difference (list end start) bounds1))
- (pcase step
- (`-1 start)
- (`1 end))))
- (new-front (save-excursion
- (goto-char front)
- (with-demoted-errors
- (dotimes (_ (abs n))
- (easy-kill-thing-forward-1 thing step)))
- (point))))
- (pcase (and (/= front new-front)
- (sort (cons new-front bounds1) #'<))
- (`(,start ,_ ,end)
- (easy-kill-adjust-candidate thing start end)
- t)))))
-
-(defun easy-kill-thing (&optional thing n inhibit-handler)
- ;; N can be -, + and digits
- (interactive
- (list (pcase (assq last-command-event easy-kill-alist)
- (`(,_ ,th . ,_) th)
- (`(,_ . ,th) th))
- (prefix-numeric-value current-prefix-arg)))
- (let* ((thing (or thing (easy-kill-get thing)))
- (n (or n 1))
- (handler (and (not inhibit-handler)
- (easy-kill-thing-handler (format "easy-kill-on-%s"
thing)
- major-mode))))
- (when (easy-kill-get mark)
- (goto-char (easy-kill-get origin)))
- (cond
- (handler (funcall handler n))
- ((or (memq n '(+ -))
- (and (eq thing (easy-kill-get thing))
- (not (zerop n))))
- (easy-kill-thing-forward (pcase n
- (`+ 1)
- (`- -1)
- (_ n))))
- (t (pcase (easy-kill-bounds-of-thing-at-point thing)
- (`nil (easy-kill-echo "No `%s'" thing))
- (`(,start . ,end)
- (easy-kill-adjust-candidate thing start end)
- (unless (zerop n)
- (easy-kill-thing-forward (1- n)))))))
- (when (easy-kill-get mark)
- (easy-kill-adjust-candidate (easy-kill-get thing)))))
-
-(put 'easy-kill-abort 'easy-kill-exit t)
-(defun easy-kill-abort ()
- (interactive)
- (when (easy-kill-get mark)
- ;; The after-string may interfere with `goto-char'.
- (overlay-put (easy-kill-get origin-indicator) 'after-string nil)
- (goto-char (easy-kill-get origin))
- (setq deactivate-mark t))
- (ding))
-
-(put 'easy-kill-region 'easy-kill-exit t)
-(defun easy-kill-region ()
- "Kill current selection and exit."
- (interactive "*")
- (pcase (easy-kill-get bounds)
- (`(,_x . ,_x) (easy-kill-echo "Empty region"))
- (`(,beg . ,end) (kill-region beg end))))
-
-(put 'easy-kill-mark-region 'easy-kill-exit t)
-(defun easy-kill-mark-region ()
- (interactive)
- (pcase (easy-kill-get bounds)
- (`(,_x . ,_x)
- (easy-kill-echo "Empty region"))
- (`(,beg . ,end)
- (pcase (if (eq (easy-kill-get mark) 'end)
- (list end beg) (list beg end))
- (`(,m ,pt)
- (set-mark m)
- (goto-char pt)))
- (activate-mark))))
-
-(defun easy-kill-exchange-point-and-mark ()
- (interactive)
- (exchange-point-and-mark)
- (setf (easy-kill-get mark)
- (if (eq (point) (easy-kill-get start))
- 'end 'start)))
-
-(put 'easy-kill-append 'easy-kill-exit t)
-(defun easy-kill-append ()
- (interactive)
- (setf (easy-kill-get append) t)
- (when (easy-kill-save-candidate)
- (easy-kill-interprogram-cut (car kill-ring))
- (setq deactivate-mark t)
- (easy-kill-echo "Appended")))
-
-(defun easy-kill-exit-p (cmd)
- (and (symbolp cmd) (get cmd 'easy-kill-exit)))
-
-(defun easy-kill-activate-keymap ()
- (let ((map (easy-kill-map)))
- (set-transient-map
- map
- (lambda ()
- ;; Prevent any error from activating the keymap forever.
- (condition-case err
- (or (and (not (easy-kill-exit-p this-command))
- (or (eq this-command
- (lookup-key map (this-single-command-keys)))
- (let ((cmd (key-binding
- (this-single-command-keys) nil t)))
- (command-remapping cmd nil (list map)))))
- (ignore
- (easy-kill-destroy-candidate)
- (unless (or (easy-kill-get mark) (easy-kill-exit-p
this-command))
- (easy-kill-save-candidate))))
- (error (message "%s:%s" this-command (error-message-string err))
- nil))))))
-
-;;;###autoload
-(defun easy-kill (&optional n)
- "Kill thing at point in the order of region, url, email and line.
-Temporally activate additional key bindings as follows:
-
- letters => select or expand selection according to `easy-kill-alist';
- 1..9 => expand selection by that number;
- 0 => shrink to the initial selection;
- +,=/- => expand or shrink selection;
- @ => append selection to previous kill;
- ? => help;
- C-w => kill selection;
- C-SPC => turn selection into an active region;
- C-g => abort;
- others => save selection and exit."
- (interactive "p")
- (if (use-region-p)
- (if (fboundp 'rectangle-mark-mode) ; New in 24.4
- (with-no-warnings
- (kill-ring-save (region-beginning) (region-end) t))
- (kill-ring-save (region-beginning) (region-end)))
- (easy-kill-init-candidate n)
- (setf (easy-kill-get append) (eq last-command 'kill-region))
- (when (zerop (buffer-size))
- (easy-kill-echo "Warn: `easy-kill' activated in empty buffer"))
- (easy-kill-activate-keymap)))
-
-;;;###autoload
-(defalias 'easy-mark-sexp 'easy-mark
- "Use `easy-mark' instead. The alias may be removed in future.")
-
-;;;###autoload
-(defun easy-mark (&optional n)
- "Similar to `easy-kill' (which see) but for marking."
- (interactive "p")
- (let ((easy-kill-try-things easy-mark-try-things))
- (easy-kill-init-candidate n 'mark)
- (easy-kill-activate-keymap)
- (unless (easy-kill-get thing)
- (setf (easy-kill-get thing) 'sexp)
- (easy-kill-thing 'sexp n))))
-
-;;;; Extended things
-
-;;; Handler for `buffer-file-name'.
-
-(defun easy-kill-on-buffer-file-name (n)
- "Get `buffer-file-name' or `default-directory'.
-If N is zero, remove the directory part; -, remove the file name
-part; +, full path."
- (if (easy-kill-get mark)
- (easy-kill-echo "Not supported in `easy-mark'")
- (pcase (or buffer-file-name default-directory)
- (`nil (easy-kill-echo "No `buffer-file-name'"))
- (file (let* ((file (directory-file-name file))
- (text (pcase n
- (`- (file-name-directory file))
- (`0 (file-name-nondirectory file))
- (_ file))))
- (easy-kill-adjust-candidate 'buffer-file-name text))))))
-
-;;; Handler for `defun-name'.
-
-(defun easy-kill-on-defun-name (_n)
- "Get current defun name."
- (if (easy-kill-get mark)
- (easy-kill-echo "Not supported in `easy-mark'")
- (pcase (add-log-current-defun)
- (`nil (easy-kill-echo "No `defun-name' at point"))
- (name (easy-kill-adjust-candidate 'defun-name name)))))
-
-;;; Handler for `url'.
-
-(defun easy-kill-on-url (&optional _n)
- "Get url at point or from char properties.
-Char properties `help-echo', `shr-url' and `w3m-href-anchor' are
-inspected."
- (if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url))
- (easy-kill-thing 'url nil t)
- (cl-labels ((get-url (text)
- (when (stringp text)
- (with-temp-buffer
- (insert text)
- (pcase (easy-kill-bounds-of-thing-at-point 'url)
- (`(,beg . ,end) (buffer-substring beg end)))))))
- (cl-dolist (p '(help-echo shr-url w3m-href-anchor))
- (pcase (get-char-property-and-overlay (point) p)
- (`(,text . ,ov)
- (pcase (or (get-url text)
- (get-url (and ov (overlay-get ov p))))
- ((and url (guard url))
- (easy-kill-adjust-candidate 'url url)
- (cl-return url)))))))))
-
-;;; `defun'
-
-;; Work around http://debbugs.gnu.org/17247
-(defun easy-kill-thing-forward-defun (&optional n)
- (pcase (or n 1)
- ((pred cl-minusp) (beginning-of-defun (- n)))
- (n (end-of-defun n))))
-
-;;; Handler for `sexp' and `list'.
-
-(defun easy-kill-bounds-of-list-at-point ()
- (let ((bos (and (nth 3 (syntax-ppss)) ;bounds of string
- (save-excursion
- (easy-kill-backward-up)
- (easy-kill-bounds-of-thing-at-point 'sexp))))
- (b (bounds-of-thing-at-point 'list))
- (b1-in-b2 (lambda (b1 b2)
- (and (> (car b1) (car b2))
- (< (cdr b1) (cdr b2))))))
- (cond
- ((not b) bos)
- ((not bos) b)
- ((= (car b) (point)) bos)
- ((funcall b1-in-b2 b bos) b)
- (t bos))))
-
-(defvar up-list-fn) ; Dynamically bound
-
-(defun easy-kill-backward-up ()
- (let ((ppss (syntax-ppss)))
- (condition-case nil
- (progn
- (funcall (or (bound-and-true-p up-list-fn) #'up-list) -1)
- ;; `up-list' may jump to another string.
- (when (and (nth 3 ppss) (< (point) (nth 8 ppss)))
- (goto-char (nth 8 ppss))))
- (scan-error (and (nth 3 ppss) (goto-char (nth 8 ppss)))))))
-
-(defun easy-kill-forward-down (point &optional bound)
- (condition-case nil
- (progn
- (easy-kill-backward-up)
- (backward-prefix-chars)
- (if (and (or (not bound) (> (point) bound))
- (/= point (point)))
- (easy-kill-forward-down (point) bound)
- (goto-char point)))
- (scan-error (goto-char point))))
-
-(defun easy-kill-bounds-of-list (n)
- (save-excursion
- (pcase n
- (`+ (goto-char (easy-kill-get start))
- (easy-kill-backward-up))
- (`- (easy-kill-forward-down (point) (easy-kill-get start)))
- (_ (error "Unsupported argument `%s'" n)))
- (easy-kill-bounds-of-thing-at-point 'sexp)))
-
-(defun easy-kill-on-list (n)
- (pcase n
- ((or `+ `-)
- (pcase (easy-kill-bounds-of-list n)
- (`(,beg . ,end)
- (easy-kill-adjust-candidate 'list beg end))))
- (_ (easy-kill-thing 'list n t))))
-
-(defun easy-kill-on-sexp (n)
- (pcase n
- ((or `+ `-)
- (unwind-protect (easy-kill-thing 'list n)
- (setf (easy-kill-get thing) 'sexp)))
- (_ (easy-kill-thing 'sexp n t))))
-
-;;; nxml support for list-wise +/-
-
-(defvar nxml-sexp-element-flag)
-
-(defun easy-kill-on-list:nxml (n)
- (let ((nxml-sexp-element-flag t)
- (up-list-fn 'nxml-up-element))
- (cond
- ((memq n '(+ -))
- (pcase (easy-kill-bounds-of-list n)
- (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
- ((and (eq 'list (easy-kill-get thing))
- (not (zerop n)))
- (let ((new-end (save-excursion
- (goto-char (easy-kill-get end))
- (forward-sexp n)
- (point))))
- (when (and new-end (/= new-end (easy-kill-get end)))
- (easy-kill-adjust-candidate 'list nil new-end))))
- (t (save-excursion
- (ignore-errors (easy-kill-backward-up))
- (easy-kill-thing 'sexp n t)
- (setf (easy-kill-get thing) 'list))))))
-
-;;; org support for list-wise +/-
-
-(defun easy-kill-bounds-of-list-at-point:org ()
- (eval-and-compile (require 'org-element))
- (let ((x (org-element-at-point)))
- (cons (org-element-property :begin x)
- (org-element-property :end x))))
-
-(defun easy-kill-bounds-of-sexp-at-point:org ()
- (pcase (list (point) (easy-kill-bounds-of-list-at-point:org))
- (`(,beg (,beg . ,end))
- (cons beg end))
- (_ (bounds-of-thing-at-point 'sexp))))
-
-(defun easy-kill-thing-forward-list:org (&optional n)
- (pcase (or n 1)
- (`0 nil)
- (n (dotimes (_ (abs n))
- (condition-case nil
- (if (cl-minusp n)
- (org-backward-element)
- (org-forward-element))
- (error (pcase (easy-kill-bounds-of-thing-at-point 'list)
- (`(,beg . ,end)
- (goto-char (if (cl-minusp n) beg end))))))))))
-
-(defun easy-kill-org-up-element (&optional n)
- ;; Make `org-up-element' more like `up-list'.
- (pcase (or n 1)
- (`0 nil)
- (n (ignore-errors
- (dotimes (_ (abs n))
- (pcase (list (point) (easy-kill-bounds-of-thing-at-point 'list))
- (`(,_beg (,_beg . ,_)) (org-up-element))
- (`(,_ (,beg . ,_)) (goto-char beg)))))
- (when (cl-plusp n)
- (goto-char (cdr (easy-kill-bounds-of-thing-at-point 'list)))))))
-
-(defun easy-kill-on-list:org (n)
- (pcase n
- ((or `+ `-)
- (pcase (let ((up-list-fn #'easy-kill-org-up-element))
- (easy-kill-bounds-of-list n))
- (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
- (_ (easy-kill-thing 'list n t)))
- (pcase (save-excursion
- (goto-char (easy-kill-get start))
- (org-element-type (org-element-at-point)))
- (`nil nil)
- (type (setf (easy-kill-get describe-thing)
- (lambda ()
- (format "%s (%s)" (easy-kill-get thing) type)))
- (easy-kill-echo "%s" type))))
-
-;;; js2 support for list-wise +/-
-
-(defun easy-kill-find-js2-node (beg end &optional inner)
- (eval-and-compile (require 'js2-mode nil t))
- (let* ((node (js2-node-at-point))
- (last-node node))
- (while (progn
- (if (or (js2-ast-root-p node)
- (and (<= (js2-node-abs-pos node) beg)
- (>= (js2-node-abs-end node) end)
- (or inner
- (not (and (= (js2-node-abs-pos node) beg)
- (= (js2-node-abs-end node) end))))))
- nil
- (setq last-node node
- node (js2-node-parent node))
- t)))
- (if inner last-node node)))
-
-(defun easy-kill-on-list:js2 (n)
- (let ((node (pcase n
- ((or `+ `-)
- (easy-kill-find-js2-node (easy-kill-get start)
- (easy-kill-get end)
- (eq n '-)))
- ((guard (and (eq 'list (easy-kill-get thing))
- (not (zerop n))))
- (error "List forward not supported in js2-mode"))
- (_ (js2-node-at-point)))))
- (easy-kill-adjust-candidate 'list
- (js2-node-abs-pos node)
- (js2-node-abs-end node))
- (setf (easy-kill-get describe-thing)
- ;; Also used by `sexp' so delay computation until needed.
- (lambda ()
- (format "%s (%s)" (easy-kill-get thing) (js2-node-short-name
node))))
- (easy-kill-echo "%s" (js2-node-short-name node))))
-
-(provide 'easy-kill)
-;;; easy-kill.el ends here
diff --git a/admin/forward-diffs.py b/admin/forward-diffs.py
new file mode 100755
index 0000000..b073ed2
--- /dev/null
+++ b/admin/forward-diffs.py
@@ -0,0 +1,432 @@
+#!/usr/bin/python
+### forward-diffs.py --- forward emacs-diffs mails to maintainers
+
+## Copyright (C) 2012-2013 Free Software Foundation, Inc.
+
+## Author: Glenn Morris <address@hidden>
+## Maintainer: address@hidden
+
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+
+## You should have received a copy of the GNU General Public License
+## along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+### Commentary:
+
+## Forward emails from an emacs-diffs style mailing list to the
+## maintainer(s) of the modified files.
+
+## Two modes of operation:
+
+## 1) Create the maintfile (really this is just an optimization):
+## forward-diffs.py --create -p packagesdir -m maintfile
+
+## You can start with an empty maintfile and normal operation in 2)
+## will append information as needed.
+
+## 2) Call from eg procmail to forward diffs. Example usage:
+
+## :0c
+## * address@hidden
+## | forward-diffs.py -p packagedir -m maintfile -l logfile \
+## -o overmaint -s sender
+
+## where
+
+## packagedir = /path/to/packages
+## sender = your email address
+## logfile = file to write log to (you might want to rotate/compress/examine
it)
+## maintfile = file listing files and their maintainers, with format:
+##
+## package1/file1 email1
+## package2/file2 email2,email3
+## package3 email4
+##
+## Use "nomail" for the email field to not send a mail.
+## An entry that is a directory applies to all files in that directory
+## that do not have specific maintainers.
+##
+## overmaint = like maintfile, but takes precedence over it.
+
+### Code:
+
+import optparse
+import sys
+import re
+import email
+import smtplib
+import datetime
+import os
+
+
+## Scan FILE for Author or Maintainer (preferred) headers.
+## Return a list of all email addresses found in MAINTS.
+def scan_file(file, maints):
+
+ try:
+ fd = open( file, 'r')
+ except Exception as err:
+ lfile.write('Error opening file %s: %s\n' % (file, str(err)))
+ return 1
+
+ ## Max number of lines to scan looking for a maintainer.
+ ## (20 seems to be the highest at present).
+ max_lines = 50
+ nline = 0
+ cont = 0
+ type = ""
+
+ for line in fd:
+
+ nline += 1
+
+ if ( nline > max_lines ): break
+
+ ## Try and de-obfuscate. Worth it?
+ line = re.sub( '(?i) AT ', '@', line )
+ line = re.sub( '(?i) DOT ', '.', line )
+
+ if cont: # continued header?
+ reg = re.match( ('%s[ \t]+[^:]*?<?(address@hidden)>?' % prefix),
line, re.I )
+ if not reg: # not a continued header
+ cont = 0
+ prefix = ""
+ if ( type == "maint" ): break
+ type = ""
+
+ ## Check for one header immediately after another.
+ if not cont:
+ reg = re.match( '([^ ]+)? *(Author|Maintainer)s?:
.*?<?(address@hidden)>?', line, re.I )
+
+
+ if not reg: continue
+
+ if cont:
+ email = reg.group(1)
+ maints.append(email)
+ else:
+ cont = 1
+ prefix = reg.group(1) or ""
+ type = reg.group(2)
+ email = reg.group(3)
+ type = "maint" if re.search( 'Maintainer', type, re.I ) else "auth"
+ ## maints = [] does the wrong thing.
+ if type == "maint": del maints[:]
+ maints.append(email)
+
+ fd.close()
+
+
+## Scan all the files under dir for maintainer information.
+## Write to stdout, or optional argument outfile (which is overwritten).
+def scan_dir(dir, outfile=None):
+
+ dir = re.sub( '/+$', '', dir) + '/' # ensure trailing /
+
+ if not os.path.isdir(dir):
+ sys.stderr.write('No such directory: %s\n' % dir)
+ sys.exit(1)
+
+ fd = 0
+ if outfile:
+ try:
+ fd = open( outfile, 'w' )
+ except Exception as err:
+ sys.stderr.write("Error opening `%s': %s\n" % (outfile, str(err)))
+ sys.exit(1)
+
+
+ for dirpath, dirnames, filenames in os.walk(dir):
+ for file in filenames:
+ path = os.path.join(dirpath, file)
+ maints = []
+ scan_file(path, maints)
+ ## This would skip printing empty maints.
+ ## That would mean we would scan the file each time for no reason.
+ ## But empty maintainers are an error at present.
+ if not maints: continue
+ path = re.sub( '^%s' % dir, '', path )
+ string = "%-50s %s\n" % (path, ",".join(maints))
+ if fd:
+ fd.write(string)
+ else:
+ print string,
+
+ if fd: fd.close()
+
+
+usage="""usage: %prog <-p /path/to/packages> <-m maintfile>
+ <-l logfile -s sender|--create> [-o overmaintfile] [--prefix prefix]
+ [--sendmail] [--debug]
+Take an emacs-diffs mail on stdin, and forward it to the maintainer(s)."""
+
+parser = optparse.OptionParser()
+parser.set_usage ( usage )
+parser.add_option( "-m", dest="maintfile", default=None,
+ help="file listing packages and maintainers")
+parser.add_option( "-l", dest="logfile", default=None,
+ help="file to append output to")
+parser.add_option( "-o", dest="overmaintfile", default=None,
+ help="override file listing packages and maintainers")
+parser.add_option( "-p", dest="packagedir", default=None,
+ help="path to packages directory")
+parser.add_option( "-s", dest="sender", default=None,
+ help="sender address for forwards")
+parser.add_option( "--create", dest="create", default=False,
+ action="store_true", help="create maintfile")
+parser.add_option( "--no-scan", dest="noscan", default=True,
+ action="store_true",
+ help="don't scan for maintainers; implies --no-update")
+parser.add_option( "--no-update", dest="noupdate", default=False,
+ action="store_true",
+ help="do not update the maintfile")
+parser.add_option( "--prefix", dest="prefix", default="packages/",
+ help="prefix to remove from modified file name [default:
%default]")
+parser.add_option( "--sendmail", dest="sendmail", default=False,
+ action="store_true", help="use sendmail rather than smtp")
+parser.add_option( "--debug", dest="debug", default=False,
+ action="store_true", help="debug only, do not send mail")
+
+
+( opts, args ) = parser.parse_args()
+
+
+if not opts.maintfile:
+ parser.error('No maintfile specified')
+
+if not opts.packagedir:
+ parser.error('No packagedir specified')
+
+if not os.path.isdir(opts.packagedir):
+ sys.stderr.write('No such directory: %s\n' % opts.packagedir)
+ sys.exit(1)
+
+
+if not opts.create:
+ if not opts.logfile:
+ parser.error('No logfile specified')
+
+ if not opts.sender:
+ parser.error('No sender specified')
+
+
+try:
+ lfile = open( opts.logfile, 'a' )
+except Exception as err:
+ sys.stderr.write('Error opening logfile: %s\n' % str(err))
+ sys.exit(1)
+
+
+try:
+ mfile = open( opts.maintfile, 'r' )
+except Exception as err:
+ lfile.write('Error opening maintfile: %s\n' % str(err))
+ sys.exit(1)
+
+## Create the maintfile.
+if opts.create:
+ scan_dir( opts.packagedir, opts.maintfile )
+ sys.exit()
+
+
+## Each element is package/file: maint1, maint2, ...
+maints = {}
+
+for line in mfile:
+ if re.match( '#| *$', line ): continue
+ ## FIXME error here if empty maintainer.
+ (pfile, maint) = line.split()
+ maints[pfile] = maint.split(',')
+
+mfile.close()
+
+
+if opts.overmaintfile:
+ try:
+ ofile = open( opts.overmaintfile, 'r' )
+ except Exception as err:
+ lfile.write('Error opening overmaintfile: %s\n' % str(err))
+ sys.exit(1)
+
+ for line in ofile:
+ if re.match( '#| *$', line ): continue
+ (pfile, maint) = line.split()
+ maints[pfile] = maint.split(',')
+
+ ofile.close()
+
+
+stdin = sys.stdin
+
+text = stdin.read()
+
+
+resent_via = 'GNU Emacs diff forwarder'
+
+message = email.message_from_string( text )
+
+(msg_name, msg_from) = email.utils.parseaddr( message['from'] )
+
+lfile.write('\nDate: %s\n' % str(datetime.datetime.now()))
+lfile.write('Message-ID: %s\n' % message['message-id'])
+lfile.write('From: %s\n' % msg_from)
+
+if resent_via == message['x-resent-via']:
+ lfile.write('Mail loop; aborting\n')
+ sys.exit(1)
+
+
+start = False
+pfiles_seen = []
+maints_seen = []
+
+for line in text.splitlines():
+
+ # Look for and process things that look like (Git):
+ #
+ # Summary of changes:
+ # packages/vlf/vlf.el | 2 +-
+ # 1 files changed, 1 insertions(+), 1 deletions(-)
+
+ #BZR: if re.match( 'modified:$', line ):
+ if re.match( 'Summary of changes:$', line ):
+ start = True
+ continue
+
+ if not start: continue
+
+ ## An empty line or a line with non-empty first character.
+ if re.match( '( *$|[^ ])', line ): break
+ # Any line that doesn't match the diffstat format (Git).
+ if not re.match( ' [^ ]+ +\| ', line ):
+ lfile.write('Stop scanning at: %s\n' % line)
+ break
+
+ if opts.prefix:
+ #BZR: reg = re.match( '%s([^ ]+)' % opts.prefix, line.strip() )
+ reg = re.match( ' %s([^ ]+)' % opts.prefix, line )
+ if not reg:
+ lfile.write('Skip: %s\n' % line)
+ continue
+ pfile = reg.group(1)
+ else:
+ pfile = line.strip()
+
+
+ lfile.write('File: %s\n' % pfile)
+
+ ## Should not be possible for files (rather than packages)...
+ if pfile in pfiles_seen:
+ lfile.write('Already seen this file\n')
+ continue
+
+ pfiles_seen.append(pfile)
+
+
+ if not pfile in maints:
+
+ lfile.write('Unknown maintainer\n')
+
+ if not opts.noscan:
+
+ lfile.write('Scanning file...\n')
+ thismaint = []
+ thisfile = os.path.join( opts.packagedir, pfile )
+ # scan_file( thisfile, thismaint )
+
+ if thismaint:
+ maints[pfile] = thismaint
+
+ ## Append maintainer to file.
+ if not opts.noupdate:
+ try:
+ mfile = open( opts.maintfile, 'a' )
+ string = "%-50s %s\n" % (pfile, ",".join(thismaint))
+ mfile.write(string)
+ mfile.close()
+ lfile.write('Appended to maintfile\n')
+ except Exception as err:
+ lfile.write('Error appending to maintfile: %s\n' %
+ str(err))
+
+ ## Didn't scan, or scanning did not work.
+ ## Look for a directory maintainer.
+ if not pfile in maints:
+ lfile.write('No file maintainer, trying directories...\n')
+ while True:
+ (pfile, tail) = os.path.split(pfile)
+ if not pfile: break
+ if pfile in maints: break
+
+
+ if not pfile in maints:
+ lfile.write('No maintainer, skipping\n')
+ continue
+
+
+ for maint in maints[pfile]:
+
+ lfile.write('Maint: %s\n' % maint)
+
+
+ if maint in maints_seen:
+ lfile.write('Already seen this maintainer\n')
+ continue
+
+ maints_seen.append(maint)
+
+
+ if maint == "nomail":
+ lfile.write('Not resending, no mail is requested\n')
+ continue
+
+
+ if maint == msg_from:
+ lfile.write('Not resending, since maintainer = committer\n')
+ continue
+
+
+ forward = message
+ forward.add_header('X-Resent-Via', resent_via)
+ forward.add_header('Resent-To', maint)
+ forward.add_header('Resent-From', opts.sender)
+
+ lfile.write('Resending via %s...\n' % ('sendmail'
+ if opts.sendmail else 'smtp') )
+
+
+ if opts.debug: continue
+
+
+ if opts.sendmail:
+ s = os.popen("/usr/sbin/sendmail -i -f %s %s" %
+ (opts.sender, maint), "w")
+ s.write(forward.as_string())
+ status = s.close()
+ if status:
+ lfile.write('Sendmail exit status: %s\n' % status)
+
+ else:
+
+ try:
+ s = smtplib.SMTP('localhost')
+ except Exception as err:
+ lfile.write('Error opening smtp: %s\n' % str(err))
+ sys.exit(1)
+
+ try:
+ s.sendmail(opts.sender, maint, forward.as_string())
+ except Exception as err:
+ lfile.write('Error sending smtp: %s\n' % str(err))
+
+ s.quit()
+
+### forward-diffs.py ends here
diff --git a/admin/org-synch.el b/admin/org-synch.el
new file mode 100644
index 0000000..cc7e923
--- /dev/null
+++ b/admin/org-synch.el
@@ -0,0 +1,22 @@
+(defun org-synch (package-file)
+ (let* ((archive-file "archive-contents")
+ (package-name 'org)
+ (date (substring package-file 4 12))
+ (date-int (string-to-number date))
+ contents entry)
+ (unless (and (integerp date-int)
+ (> date-int 20100000)
+ (< date-int 21000000))
+ (error "Package date is bad"))
+ (unless (file-exists-p package-file)
+ (error "No package file found"))
+ (when (file-exists-p archive-file)
+ (find-file archive-file)
+ (setq contents (read (current-buffer))
+ entry (assq package-name contents))
+ (unless entry
+ (error "No entry for %s in archive-contents" package-name))
+ (aset (cdr entry) 0 (version-to-list date))
+ (erase-buffer)
+ (insert (pp-to-string contents) "\n")
+ (save-buffer 0))))
diff --git a/admin/org-synch.sh b/admin/org-synch.sh
new file mode 100755
index 0000000..02696b2
--- /dev/null
+++ b/admin/org-synch.sh
@@ -0,0 +1,15 @@
+#!/bin/sh
+
+# this script expects $1 to be the download directory and $2 to have
org-synch.el
+
+PATH="/bin:/usr/bin:/usr/local/bin:${PATH}"
+
+pkgname=`curl -s http://orgmode.org/elpa/|perl -ne 'push @f, $1 if
m/(org-\d{8}\.tar)/; END { @f = sort @f; print "$f[-1]\n"}'`
+
+cd $1
+wget -q http://orgmode.org/elpa/${pkgname} -O ${pkgname}-tmp
+if [ -f ${pkgname}-tmp ]; then
+ rm -f org*.tar
+ mv ${pkgname}-tmp ${pkgname} && \
+ emacs -batch -l $2/org-synch.el --eval "(org-synch \"${pkgname}\")"
+fi
diff --git a/admin/overmaint.txt b/admin/overmaint.txt
new file mode 100644
index 0000000..328d1aa
--- /dev/null
+++ b/admin/overmaint.txt
@@ -0,0 +1,12 @@
+# This file lists files and the email addresses of their maintainers.
+# It is used by the forward-diffs.py script.
+# This file overrides the automatically generated maintfile.
+# Use nomail to suppress sending mail.
+# File names are relative to the packages/ directory.
+# Lines starting with # are ignored.
+# Examples:
+#some-package/some-file.el nomail
+#some-package/otherfile.el address@hidden
+
+register-alist/register-list.el address@hidden
+windresize/windresize.el.el address@hidden
diff --git a/admin/update-archive.sh b/admin/update-archive.sh
new file mode 100755
index 0000000..91e99f9
--- /dev/null
+++ b/admin/update-archive.sh
@@ -0,0 +1,106 @@
+#!/bin/sh -x
+
+makelog=""
+buildir="$(pwd)"
+
+export LANG=C
+case "$1" in
+ "--batch")
+ makelog="$(pwd)/make.log"
+ exec >"$makelog" 2>&1
+ ;;
+esac
+
+# Send an email to warn about a problem.
+signal_error () {
+ title="$*"
+ if [ "" = "$makelog" ]; then
+ echo "Error: $title"
+ else
+ mx_gnu_org="$(host -t mx gnu.org | sed 's/.*[ ]//')"
+ (sleep 5; echo "HELO elpa.gnu.org"
+ sleep 1; echo "MAIL FROM: <address@hidden>"
+ sleep 1; echo "RCPT TO: <address@hidden>"
+ sleep 1; echo "DATA"
+ sleep 1; cat <<ENDDOC
+From: ELPA update <address@hidden>
+To: address@hidden
+Subject: $title
+
+ENDDOC
+ cat "$makelog"
+ echo "."; sleep 1) | telnet "$mx_gnu_org" smtp
+ fi
+ exit 1
+}
+
+
+cd ../elpa
+
+# Fetch changes.
+git pull || signal_error "git pull failed"
+
+# Remember we're inside the "elpa" branch which we don't want to trust,
+# So always refer to the makefile and admins files from $builddir".
+
+# Setup and update externals.
+emacs --batch -l "$buildir/admin/archive-contents.el" \
+ -f archive-add/remove/update-externals
+
+make -f "$buildir/GNUmakefile" check_copyrights ||
+ signal_error "check_copyright failed"
+
+cd "$buildir"
+
+rsync -av --delete \
+ --exclude=ChangeLog \
+ --exclude=.git \
+ --exclude='*.elc' \
+ --exclude='*~' \
+ --exclude='*-autoloads.el' \
+ ../elpa/packages ./
+
+# Refresh the ChangeLog files. This needs to be done in
+# the source tree, because it needs the VCS data!
+emacs -batch -l admin/archive-contents.el \
+ -eval '(archive-prepare-packages "../elpa")'
+
+
+rm -rf archive # In case there's one left over!
+make archive-full || {
+ signal_error "make archive-full failed"
+}
+latest="emacs-packages-latest.tgz"
+(cd archive
+ GZIP=--best tar zcf "$latest" packages)
+(cd ../
+ mkdir -p staging/packages
+ # Not sure why we have `staging-old', but let's keep it for now.
+ rm -rf staging-old
+ cp -a staging staging-old
+ # Move new files into place but don't throw out old package versions.
+ for f in build/archive/packages/*; do
+ dst="staging/packages/$(basename "$f")"
+ # Actually, let's never overwrite an existing version. So changes can
+ # be installed without causing a new package to be built until the
+ # version field is changed. Some files need to be excluded from the
+ # "immutable" policy, most importantly "archive-contents"
+ # and "*-readme.txt".
+ case $dst in
+ */archive-contents | *-readme.txt ) mv "$f" "$dst" ;;
+ * ) if [ -r "$dst" ]
+ then rm "$f"
+ else
+ # FIXME: Announce the new package/version on
+ # gnu.emacs.sources!
+ mv "$f" "$dst"
+ fi ;;
+ esac
+ done
+ mv build/archive/"$latest" staging/
+ rm -rf build/archive)
+
+# Make the HTML and readme.txt files.
+(cd ../staging/packages
+ emacs --batch -l ../../build/admin/archive-contents.el \
+ --eval '(batch-html-make-index)')
diff --git a/admin/.elpaignore b/packages/easy-kill/.elpaignore
similarity index 100%
rename from admin/.elpaignore
rename to packages/easy-kill/.elpaignore
diff --git a/admin/.travis.yml b/packages/easy-kill/.travis.yml
similarity index 100%
rename from admin/.travis.yml
rename to packages/easy-kill/.travis.yml
diff --git a/admin/Makefile b/packages/easy-kill/Makefile
similarity index 100%
rename from admin/Makefile
rename to packages/easy-kill/Makefile
diff --git a/packages/easy-kill/README.rst b/packages/easy-kill/README.rst
index ef660aa..02ad57b 100644
--- a/packages/easy-kill/README.rst
+++ b/packages/easy-kill/README.rst
@@ -2,6 +2,11 @@
Kill & Mark Things Easily in Emacs
====================================
+.. image:: https://travis-ci.org/leoliu/easy-kill.svg?branch=master
+ :target: https://travis-ci.org/leoliu/easy-kill
+ :align: right
+ :alt: Travis CI build status
+
Provide commands ``easy-kill`` and ``easy-mark`` to let users kill or
mark things easily.
@@ -34,9 +39,12 @@ The following keys modify the selection:
#. address@hidden: append selection to previous kill and exit. For example,
``M-w d @`` will append current function to last kill.
#. ``C-w``: kill selection and exit
-#. ``+``, ``-`` and ``0..9``: expand/shrink selection
+#. ``+``, ``-`` and ``1..9``: expand/shrink selection
+#. ``0`` shrink the selection to the intitial size i.e. before any
+ expansion
#. ``C-SPC``: turn selection into an active region
#. ``C-g``: abort
+#. ``?``: help
For example, ``M-w w`` saves current word, repeat ``w`` to expand the
kill to include the next word. ``5`` to include the next 5 words etc.
@@ -48,7 +56,8 @@ for ``list`` or ``sexp``, list-wise.
``list-wise`` expanding/shrinking work well in lispy modes (elisp,
Common Lisp, Scheme, Clojure etc.), smie-based modes (Prolog, SML,
-Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Nxml mode and Js2 mode.
+Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Org mode, Nxml mode and
+Js2 mode.
To copy the enclosing list in lispy modes, I used to do a lot of
``C-M-u C-M-SPC M-w``. Now the key sequence is replaced by ``M-w l``
@@ -86,6 +95,16 @@ convention, or by defining new functions named like
NEWS
~~~~
+0.9.3
++++++
+
+#. Key ``?`` in ``easy-kill`` or ``easy-mark`` prints help info.
+#. ``M-w l`` can select the enclosing string.
+#. ``easy-mark`` learns exchanging point & mark.
+#. Key ``0`` now sets the selection to its initial size before any
+ expansion.
+#. ``M-w l``, ``M-w s`` and list-wise ``+/-`` now work in Org mode.
+
0.9.2
+++++
diff --git a/packages/easy-kill/easy-kill.el b/packages/easy-kill/easy-kill.el
index 8195bfc..5db6823 100644
--- a/packages/easy-kill/easy-kill.el
+++ b/packages/easy-kill/easy-kill.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Leo Liu <address@hidden>
-;; Version: 0.9.2
+;; Version: 0.9.3
;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
;; Keywords: killing, convenience
;; Created: 2013-08-12
@@ -70,14 +70,13 @@
(add-hook 'pre-command-hook clearfunsym)
(push alist emulation-mode-map-alists))))))
-(defcustom easy-kill-alist
- '((?w word " ")
- (?s sexp "\n")
- (?l list "\n")
- (?f filename "\n")
- (?d defun "\n\n")
- (?e line "\n")
- (?b buffer-file-name))
+(defcustom easy-kill-alist '((?w word " ")
+ (?s sexp "\n")
+ (?l list "\n")
+ (?f filename "\n")
+ (?d defun "\n\n")
+ (?e line "\n")
+ (?b buffer-file-name))
"A list of (CHAR THING APPEND).
CHAR is used immediately following `easy-kill' to select THING.
APPEND is optional and if non-nil specifies the separator (a
@@ -113,24 +112,18 @@ deprecated."
(define-key map "+" 'easy-kill-expand)
(define-key map "=" 'easy-kill-expand)
(define-key map "@" 'easy-kill-append)
+ ;; Note: didn't pick C-h because it is a very useful prefix key.
+ (define-key map "?" 'easy-kill-help)
(define-key map [remap set-mark-command] 'easy-kill-mark-region)
(define-key map [remap kill-region] 'easy-kill-region)
(define-key map [remap keyboard-quit] 'easy-kill-abort)
+ (define-key map [remap exchange-point-and-mark]
+ 'easy-kill-exchange-point-and-mark)
(mapc (lambda (d)
(define-key map (number-to-string d) 'easy-kill-digit-argument))
(number-sequence 0 9))
map))
-(defun easy-kill-map ()
- "Build the keymap according to `easy-kill-alist'."
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map easy-kill-base-map)
- (mapc (lambda (c)
- ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select)
- (define-key map (char-to-string c) 'easy-kill-thing))
- (mapcar 'car easy-kill-alist))
- map))
-
(defvar easy-kill-inhibit-message nil)
(defun easy-kill-echo (format-string &rest args)
@@ -148,6 +141,12 @@ Do nothing if `easy-kill-inhibit-message' is non-nil."
(`right (substring s 0 (string-match-p (concat wchars "\\'") s)))
(_ (easy-kill-trim (easy-kill-trim s 'left) 'right)))))
+(defun easy-kill-mode-sname (m)
+ (cl-check-type m (and (or symbol string) (not boolean)))
+ (cl-etypecase m
+ (symbol (easy-kill-mode-sname (symbol-name m)))
+ (string (substring m 0 (string-match-p "\\(?:-minor\\)?-mode\\'" m)))))
+
(defun easy-kill-fboundp (name)
"Like `fboundp' but NAME can be string or symbol.
The value is the function's symbol if non-nil."
@@ -168,9 +167,52 @@ The value is the function's symbol if non-nil."
(not (equal text ""))
(funcall interprogram-cut-function text)))
+(defun easy-kill-map ()
+ "Build the keymap according to `easy-kill-alist'."
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map easy-kill-base-map)
+ (mapc (lambda (c)
+ ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select)
+ (define-key map (char-to-string c) 'easy-kill-thing))
+ (mapcar 'car easy-kill-alist))
+ map))
+
+(defun easy-kill--fmt (x y &optional z)
+ (cl-etypecase x
+ (character (easy-kill--fmt
+ (single-key-description x)
+ (symbol-name y)
+ (and z (let ((print-escape-newlines t))
+ (prin1-to-string z)))))
+ (string (with-output-to-string
+ (princ x)
+ (princ (make-string (- 16 (mod (length x) 16)) ?\s))
+ (princ y)
+ (when z
+ (princ (make-string (- 16 (mod (length y) 16)) ?\s))
+ (princ z))))))
+
+(defun easy-kill-help ()
+ (interactive)
+ (help-setup-xref '(easy-kill-help) (called-interactively-p 'any))
+ (with-help-window (help-buffer)
+ (princ (concat (make-string 15 ?=) " "))
+ (princ "Easy Kill/Mark Key Bindings ")
+ (princ (concat (make-string 15 ?=) "\n\n"))
+ (princ (easy-kill--fmt "Key" "Thing" "Separator"))
+ (princ "\n")
+ (princ (easy-kill--fmt "---" "-----" "---------"))
+ (princ "\n\n")
+ (princ (mapconcat (lambda (x) (pcase x
+ (`(,c ,thing ,sep)
+ (easy-kill--fmt c thing sep))
+ ((or `(,c ,thing) `(,c . ,thing))
+ (easy-kill--fmt c thing))))
+ easy-kill-alist "\n"))
+ (princ "\n\n")
+ (princ (substitute-command-keys "\\{easy-kill-base-map}"))))
+
(defvar easy-kill-candidate nil)
-(defvar easy-kill-append nil)
-(defvar easy-kill-mark nil)
(defun easy-kill--bounds ()
(cons (overlay-start easy-kill-candidate)
@@ -195,21 +237,23 @@ Use `setf' to change property value."
(`buffer '(overlay-buffer easy-kill-candidate))
(`properties '(append (list 'start (easy-kill-get start))
(list 'end (easy-kill-get end))
+ (list 'buffer (easy-kill-get buffer))
(overlay-properties easy-kill-candidate)))
(_ `(overlay-get easy-kill-candidate ',prop))))
-(defun easy-kill-init-candidate (n)
+(defun easy-kill-init-candidate (n &optional mark)
;; Manipulate `easy-kill-candidate' directly during initialisation;
;; should use `easy-kill-get' elsewhere.
(let ((o (make-overlay (point) (point))))
- (unless easy-kill-mark
+ (unless mark
(overlay-put o 'face 'easy-kill-selection))
(overlay-put o 'origin (point))
(overlay-put o 'help-echo #'easy-kill-describe-candidate)
;; Use higher priority to avoid shadowing by, for example,
;; `hl-line-mode'.
(overlay-put o 'priority 999)
- (when easy-kill-mark
+ (when mark
+ (overlay-put o 'mark 'start)
(let ((i (make-overlay (point) (point))))
(overlay-put i 'priority (1+ (overlay-get o 'priority)))
(overlay-put i 'face 'easy-kill-origin)
@@ -262,7 +306,9 @@ Otherwise, it is the value of the overlay's candidate
property."
(plist-get all k))
when v collect (format "%s:\t%s" k v)))
(txt (mapconcat #'identity props "\n")))
- (format "cmd:\t%s\n%s" (if easy-kill-mark "easy-mark" "easy-kill") txt)))
+ (format "cmd:\t%s\n%s"
+ (if (easy-kill-get mark) "easy-mark" "easy-kill")
+ txt)))
(defun easy-kill-adjust-candidate (thing &optional beg end)
"Adjust kill candidate to THING, BEG, END.
@@ -277,9 +323,11 @@ candidate property instead."
(t
(setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start))
(or end (easy-kill-get end))))))
- (cond (easy-kill-mark (easy-kill-mark-region)
- (easy-kill-indicate-origin))
- (t (easy-kill-interprogram-cut (easy-kill-candidate)))))
+ (cond ((easy-kill-get mark)
+ (easy-kill-mark-region)
+ (easy-kill-indicate-origin))
+ (t
+ (easy-kill-interprogram-cut (easy-kill-candidate)))))
(defun easy-kill-save-candidate ()
(unless (string= (easy-kill-candidate) "")
@@ -289,7 +337,7 @@ candidate property instead."
;; `easy-kill-adjust-candidate' already did that.
(let ((interprogram-cut-function nil)
(interprogram-paste-function nil))
- (kill-new (if (and easy-kill-append kill-ring)
+ (kill-new (if (and (easy-kill-get append) kill-ring)
(cl-labels ((join (x sep y)
(if sep (concat (easy-kill-trim x 'right)
sep
@@ -300,7 +348,7 @@ candidate property instead."
easy-kill-alist :key #'car))
(easy-kill-candidate)))
(easy-kill-candidate))
- easy-kill-append))
+ (easy-kill-get append)))
t))
(defun easy-kill-destroy-candidate ()
@@ -321,6 +369,9 @@ candidate property instead."
(easy-kill-thing nil '+))
(defun easy-kill-digit-argument (n)
+ "Expand selection by N number of things.
+If N is 0 shrink the selection to the initial size before any
+expansion."
(interactive
(list (- (logand (if (integerp last-command-event)
last-command-event
@@ -333,12 +384,45 @@ candidate property instead."
(interactive)
(easy-kill-thing nil '-))
+(defun easy-kill-thing-handler (base mode)
+ "Get the handler for MODE or nil if none is defined.
+For example, if BASE is \"easy-kill-on-list\" and MODE is
+nxml-mode `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are
+checked in order. The former is never defined in this package and
+is safe for users to customise. If neither is defined continue
+checking on the parent mode. Finally `easy-kill-on-list' is
+checked."
+ (or (and mode (or (easy-kill-fboundp
+ (concat (easy-kill-mode-sname mode) ":" base))
+ (easy-kill-fboundp
+ (concat base ":" (easy-kill-mode-sname mode)))))
+ (let ((parent (get mode 'derived-mode-parent)))
+ (and parent (easy-kill-thing-handler base parent)))
+ (easy-kill-fboundp base)))
+
+(defun easy-kill-bounds-of-thing-at-point (thing)
+ "Easy Kill wrapper for `bounds-of-thing-at-point'."
+ (pcase (easy-kill-thing-handler
+ (format "easy-kill-bounds-of-%s-at-point" thing)
+ major-mode)
+ ((and (pred functionp) fn) (funcall fn))
+ (_ (bounds-of-thing-at-point thing))))
+
+(defun easy-kill-thing-forward-1 (thing &optional n)
+ "Easy Kill wrapper for `forward-thing'."
+ (pcase (easy-kill-thing-handler
+ (format "easy-kill-thing-forward-%s" thing)
+ major-mode)
+ ((and (pred functionp) fn) (funcall fn n))
+ (_ (forward-thing thing n))))
+
;; Helper for `easy-kill-thing'.
(defun easy-kill-thing-forward (n)
(when (and (easy-kill-get thing) (/= n 0))
(let* ((step (if (cl-minusp n) -1 +1))
(thing (easy-kill-get thing))
- (bounds1 (or (easy-kill-pair-to-list (bounds-of-thing-at-point
thing))
+ (bounds1 (or (easy-kill-pair-to-list
+ (easy-kill-bounds-of-thing-at-point thing))
(list (point) (point))))
(start (easy-kill-get start))
(end (easy-kill-get end))
@@ -349,15 +433,8 @@ candidate property instead."
(new-front (save-excursion
(goto-char front)
(with-demoted-errors
- (cl-labels ((forward-defun (s)
- (pcase s
- (`-1
(beginning-of-defun 1))
- (`+1 (end-of-defun
1)))))
- (dotimes (_ (abs n))
- ;; Work around http://debbugs.gnu.org/17247
- (if (eq thing 'defun)
- (forward-defun step)
- (forward-thing thing step)))))
+ (dotimes (_ (abs n))
+ (easy-kill-thing-forward-1 thing step)))
(point))))
(pcase (and (/= front new-front)
(sort (cons new-front bounds1) #'<))
@@ -365,25 +442,6 @@ candidate property instead."
(easy-kill-adjust-candidate thing start end)
t)))))
-(defun easy-kill-thing-handler (thing mode)
- "Get the handler for THING or nil if none is defined.
-For example, if THING is list and MODE is nxml-mode
-`nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are checked in
-order. The former is never defined in this package and is safe
-for users to customise. If neither is defined continue checking
-on the parent mode. Finally `easy-kill-on-list' is checked."
- (cl-labels ((sname (m) (cl-etypecase m
- (symbol (sname (symbol-name m)))
- (string (substring m 0 (string-match-p
- "\\(?:-minor\\)?-mode\\'"
m))))))
- (let ((parent (get mode 'derived-mode-parent)))
- (or (and mode (or (easy-kill-fboundp
- (format "%s:easy-kill-on-%s" (sname mode) thing))
- (easy-kill-fboundp
- (format "easy-kill-on-%s:%s" thing (sname mode)))))
- (and parent (easy-kill-thing-handler thing parent))
- (easy-kill-fboundp (format "easy-kill-on-%s" thing))))))
-
(defun easy-kill-thing (&optional thing n inhibit-handler)
;; N can be -, + and digits
(interactive
@@ -394,29 +452,32 @@ on the parent mode. Finally `easy-kill-on-list' is
checked."
(let* ((thing (or thing (easy-kill-get thing)))
(n (or n 1))
(handler (and (not inhibit-handler)
- (easy-kill-thing-handler thing major-mode))))
- (when easy-kill-mark
+ (easy-kill-thing-handler (format "easy-kill-on-%s"
thing)
+ major-mode))))
+ (when (easy-kill-get mark)
(goto-char (easy-kill-get origin)))
(cond
(handler (funcall handler n))
- ((or (eq thing (easy-kill-get thing))
- (memq n '(+ -)))
+ ((or (memq n '(+ -))
+ (and (eq thing (easy-kill-get thing))
+ (not (zerop n))))
(easy-kill-thing-forward (pcase n
(`+ 1)
(`- -1)
(_ n))))
- (t (pcase (bounds-of-thing-at-point thing)
+ (t (pcase (easy-kill-bounds-of-thing-at-point thing)
(`nil (easy-kill-echo "No `%s'" thing))
(`(,start . ,end)
(easy-kill-adjust-candidate thing start end)
- (easy-kill-thing-forward (1- n))))))
- (when easy-kill-mark
+ (unless (zerop n)
+ (easy-kill-thing-forward (1- n)))))))
+ (when (easy-kill-get mark)
(easy-kill-adjust-candidate (easy-kill-get thing)))))
(put 'easy-kill-abort 'easy-kill-exit t)
(defun easy-kill-abort ()
(interactive)
- (when easy-kill-mark
+ (when (easy-kill-get mark)
;; The after-string may interfere with `goto-char'.
(overlay-put (easy-kill-get origin-indicator) 'after-string nil)
(goto-char (easy-kill-get origin))
@@ -438,14 +499,24 @@ on the parent mode. Finally `easy-kill-on-list' is
checked."
(`(,_x . ,_x)
(easy-kill-echo "Empty region"))
(`(,beg . ,end)
- (set-mark beg)
- (goto-char end)
+ (pcase (if (eq (easy-kill-get mark) 'end)
+ (list end beg) (list beg end))
+ (`(,m ,pt)
+ (set-mark m)
+ (goto-char pt)))
(activate-mark))))
+(defun easy-kill-exchange-point-and-mark ()
+ (interactive)
+ (exchange-point-and-mark)
+ (setf (easy-kill-get mark)
+ (if (eq (point) (easy-kill-get start))
+ 'end 'start)))
+
(put 'easy-kill-append 'easy-kill-exit t)
(defun easy-kill-append ()
(interactive)
- (setq easy-kill-append t)
+ (setf (easy-kill-get append) t)
(when (easy-kill-save-candidate)
(easy-kill-interprogram-cut (car kill-ring))
(setq deactivate-mark t)
@@ -469,7 +540,7 @@ on the parent mode. Finally `easy-kill-on-list' is checked."
(command-remapping cmd nil (list map)))))
(ignore
(easy-kill-destroy-candidate)
- (unless (or easy-kill-mark (easy-kill-exit-p this-command))
+ (unless (or (easy-kill-get mark) (easy-kill-exit-p
this-command))
(easy-kill-save-candidate))))
(error (message "%s:%s" this-command (error-message-string err))
nil))))))
@@ -480,9 +551,11 @@ on the parent mode. Finally `easy-kill-on-list' is
checked."
Temporally activate additional key bindings as follows:
letters => select or expand selection according to `easy-kill-alist';
- 0..9 => expand selection by that number;
+ 1..9 => expand selection by that number;
+ 0 => shrink to the initial selection;
+,=/- => expand or shrink selection;
@ => append selection to previous kill;
+ ? => help;
C-w => kill selection;
C-SPC => turn selection into an active region;
C-g => abort;
@@ -493,9 +566,8 @@ Temporally activate additional key bindings as follows:
(with-no-warnings
(kill-ring-save (region-beginning) (region-end) t))
(kill-ring-save (region-beginning) (region-end)))
- (setq easy-kill-mark nil)
- (setq easy-kill-append (eq last-command 'kill-region))
(easy-kill-init-candidate n)
+ (setf (easy-kill-get append) (eq last-command 'kill-region))
(when (zerop (buffer-size))
(easy-kill-echo "Warn: `easy-kill' activated in empty buffer"))
(easy-kill-activate-keymap)))
@@ -509,8 +581,7 @@ Temporally activate additional key bindings as follows:
"Similar to `easy-kill' (which see) but for marking."
(interactive "p")
(let ((easy-kill-try-things easy-mark-try-things))
- (setq easy-kill-mark t)
- (easy-kill-init-candidate n)
+ (easy-kill-init-candidate n 'mark)
(easy-kill-activate-keymap)
(unless (easy-kill-get thing)
(setf (easy-kill-get thing) 'sexp)
@@ -524,7 +595,7 @@ Temporally activate additional key bindings as follows:
"Get `buffer-file-name' or `default-directory'.
If N is zero, remove the directory part; -, remove the file name
part; +, full path."
- (if easy-kill-mark
+ (if (easy-kill-get mark)
(easy-kill-echo "Not supported in `easy-mark'")
(pcase (or buffer-file-name default-directory)
(`nil (easy-kill-echo "No `buffer-file-name'"))
@@ -539,7 +610,7 @@ part; +, full path."
(defun easy-kill-on-defun-name (_n)
"Get current defun name."
- (if easy-kill-mark
+ (if (easy-kill-get mark)
(easy-kill-echo "Not supported in `easy-mark'")
(pcase (add-log-current-defun)
(`nil (easy-kill-echo "No `defun-name' at point"))
@@ -551,13 +622,13 @@ part; +, full path."
"Get url at point or from char properties.
Char properties `help-echo', `shr-url' and `w3m-href-anchor' are
inspected."
- (if (or easy-kill-mark (bounds-of-thing-at-point 'url))
+ (if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url))
(easy-kill-thing 'url nil t)
(cl-labels ((get-url (text)
(when (stringp text)
(with-temp-buffer
(insert text)
- (pcase (bounds-of-thing-at-point 'url)
+ (pcase (easy-kill-bounds-of-thing-at-point 'url)
(`(,beg . ,end) (buffer-substring beg end)))))))
(cl-dolist (p '(help-echo shr-url w3m-href-anchor))
(pcase (get-char-property-and-overlay (point) p)
@@ -568,8 +639,32 @@ inspected."
(easy-kill-adjust-candidate 'url url)
(cl-return url)))))))))
+;;; `defun'
+
+;; Work around http://debbugs.gnu.org/17247
+(defun easy-kill-thing-forward-defun (&optional n)
+ (pcase (or n 1)
+ ((pred cl-minusp) (beginning-of-defun (- n)))
+ (n (end-of-defun n))))
+
;;; Handler for `sexp' and `list'.
+(defun easy-kill-bounds-of-list-at-point ()
+ (let ((bos (and (nth 3 (syntax-ppss)) ;bounds of string
+ (save-excursion
+ (easy-kill-backward-up)
+ (easy-kill-bounds-of-thing-at-point 'sexp))))
+ (b (bounds-of-thing-at-point 'list))
+ (b1-in-b2 (lambda (b1 b2)
+ (and (> (car b1) (car b2))
+ (< (cdr b1) (cdr b2))))))
+ (cond
+ ((not b) bos)
+ ((not bos) b)
+ ((= (car b) (point)) bos)
+ ((funcall b1-in-b2 b bos) b)
+ (t bos))))
+
(defvar up-list-fn) ; Dynamically bound
(defun easy-kill-backward-up ()
@@ -600,7 +695,7 @@ inspected."
(easy-kill-backward-up))
(`- (easy-kill-forward-down (point) (easy-kill-get start)))
(_ (error "Unsupported argument `%s'" n)))
- (bounds-of-thing-at-point 'sexp)))
+ (easy-kill-bounds-of-thing-at-point 'sexp)))
(defun easy-kill-on-list (n)
(pcase n
@@ -628,7 +723,8 @@ inspected."
((memq n '(+ -))
(pcase (easy-kill-bounds-of-list n)
(`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
- ((eq 'list (easy-kill-get thing))
+ ((and (eq 'list (easy-kill-get thing))
+ (not (zerop n)))
(let ((new-end (save-excursion
(goto-char (easy-kill-get end))
(forward-sexp n)
@@ -640,6 +736,60 @@ inspected."
(easy-kill-thing 'sexp n t)
(setf (easy-kill-get thing) 'list))))))
+;;; org support for list-wise +/-
+
+(defun easy-kill-bounds-of-list-at-point:org ()
+ (eval-and-compile (require 'org-element))
+ (let ((x (org-element-at-point)))
+ (cons (org-element-property :begin x)
+ (org-element-property :end x))))
+
+(defun easy-kill-bounds-of-sexp-at-point:org ()
+ (pcase (list (point) (easy-kill-bounds-of-list-at-point:org))
+ (`(,beg (,beg . ,end))
+ (cons beg end))
+ (_ (bounds-of-thing-at-point 'sexp))))
+
+(defun easy-kill-thing-forward-list:org (&optional n)
+ (pcase (or n 1)
+ (`0 nil)
+ (n (dotimes (_ (abs n))
+ (condition-case nil
+ (if (cl-minusp n)
+ (org-backward-element)
+ (org-forward-element))
+ (error (pcase (easy-kill-bounds-of-thing-at-point 'list)
+ (`(,beg . ,end)
+ (goto-char (if (cl-minusp n) beg end))))))))))
+
+(defun easy-kill-org-up-element (&optional n)
+ ;; Make `org-up-element' more like `up-list'.
+ (pcase (or n 1)
+ (`0 nil)
+ (n (ignore-errors
+ (dotimes (_ (abs n))
+ (pcase (list (point) (easy-kill-bounds-of-thing-at-point 'list))
+ (`(,_beg (,_beg . ,_)) (org-up-element))
+ (`(,_ (,beg . ,_)) (goto-char beg)))))
+ (when (cl-plusp n)
+ (goto-char (cdr (easy-kill-bounds-of-thing-at-point 'list)))))))
+
+(defun easy-kill-on-list:org (n)
+ (pcase n
+ ((or `+ `-)
+ (pcase (let ((up-list-fn #'easy-kill-org-up-element))
+ (easy-kill-bounds-of-list n))
+ (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
+ (_ (easy-kill-thing 'list n t)))
+ (pcase (save-excursion
+ (goto-char (easy-kill-get start))
+ (org-element-type (org-element-at-point)))
+ (`nil nil)
+ (type (setf (easy-kill-get describe-thing)
+ (lambda ()
+ (format "%s (%s)" (easy-kill-get thing) type)))
+ (easy-kill-echo "%s" type))))
+
;;; js2 support for list-wise +/-
(defun easy-kill-find-js2-node (beg end &optional inner)
@@ -665,7 +815,8 @@ inspected."
(easy-kill-find-js2-node (easy-kill-get start)
(easy-kill-get end)
(eq n '-)))
- ((guard (eq 'list (easy-kill-get thing)))
+ ((guard (and (eq 'list (easy-kill-get thing))
+ (not (zerop n))))
(error "List forward not supported in js2-mode"))
(_ (js2-node-at-point)))))
(easy-kill-adjust-candidate 'list
diff --git a/admin/test.el b/packages/easy-kill/test.el
similarity index 100%
rename from admin/test.el
rename to packages/easy-kill/test.el