Merge remote-tracking branch 'origin/master' into feature/pgtk

2 files changed, 524 insertions, 49 deletions

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 981e23931c2..597044cf21c 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1529,26 +1529,29 @@ the tests)."
 
 (defun ert-write-junit-test-report (stats)
   "Write a JUnit test report, generated from STATS."
-  ;; https://www.ibm.com/docs/de/developer-for-zos/14.1.0?topic=formats-junit-xml-format
+  ;; https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format
   ;; https://llg.cubic.org/docs/junit/
   (unless (zerop (length (ert--stats-tests stats)))
     (when-let ((test-file
                 (symbol-file
-                 (ert-test-name (aref (ert--stats-tests stats) 0)) 'ert--test)))
-      (with-temp-file (file-name-with-extension test-file "xml")
+                 (ert-test-name (aref (ert--stats-tests stats) 0)) 'ert--test))
+               (test-report (file-name-with-extension test-file "xml")))
+      (with-temp-file test-report
         (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
-        (insert (format "<testsuites name=\"%s\" tests=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
-                        (file-name-nondirectory test-file)
+        (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+                        (file-name-nondirectory test-report)
                         (ert-stats-total stats)
+                        (if (ert--stats-aborted-p stats) 1 0)
                         (ert-stats-completed-unexpected stats)
                         (ert-stats-skipped stats)
                         (float-time
                          (time-subtract
                           (ert--stats-end-time stats)
                           (ert--stats-start-time stats)))))
-        (insert (format "  <testsuite id=\"0\" name=\"%s\" tests=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
-                        (file-name-nondirectory test-file)
+        (insert (format "  <testsuite id=\"0\" name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
+                        (file-name-nondirectory test-report)
                         (ert-stats-total stats)
+                        (if (ert--stats-aborted-p stats) 1 0)
                         (ert-stats-completed-unexpected stats)
                         (ert-stats-skipped stats)
                         (float-time
@@ -1570,40 +1573,52 @@ the tests)."
                                   (ert-test-result-expected-p test result))
                                  (ert-test-result-duration result)))
                  (if (and (ert-test-result-expected-p test result)
+                          (not (ert-test-aborted-with-non-local-exit-p result))
                           (not (ert-test-skipped-p result))
                           (zerop (length (ert-test-result-messages result))))
                      (insert "/>\n")
                    (insert ">\n")
-                   (if (ert-test-skipped-p result)
-                       (insert (format "      <skipped message=\"%s\" type=\"%s\">\n"
-                                       (xml-escape-string
-                                        (string-trim
-                                         (ert-reason-for-test-result result)))
-                                       (ert-string-for-test-result
-                                        result
-                                        (ert-test-result-expected-p
-                                         test result)))
-                               (xml-escape-string
-                                (string-trim
-                                 (ert-reason-for-test-result result)))
-                               "\n"
-                               "      </skipped>\n")
-                     (unless
-                         (ert-test-result-type-p
-                          result (ert-test-expected-result-type test))
-                       (insert (format "      <failure message=\"%s\" type=\"%s\">\n"
-                                       (xml-escape-string
-                                        (string-trim
-                                         (ert-reason-for-test-result result)))
-                                       (ert-string-for-test-result
-                                        result
-                                        (ert-test-result-expected-p
-                                         test result)))
-                               (xml-escape-string
-                                (string-trim
-                                 (ert-reason-for-test-result result)))
-                               "\n"
-                               "      </failure>\n")))
+                   (cond
+                    ((ert-test-skipped-p result)
+                     (insert (format "      <skipped message=\"%s\" type=\"%s\">\n"
+                                     (xml-escape-string
+                                      (string-trim
+                                       (ert-reason-for-test-result result)))
+                                     (ert-string-for-test-result
+                                      result
+                                      (ert-test-result-expected-p
+                                       test result)))
+                             (xml-escape-string
+                              (string-trim
+                               (ert-reason-for-test-result result)))
+                             "\n"
+                             "      </skipped>\n"))
+                    ((ert-test-aborted-with-non-local-exit-p result)
+                     (insert (format "      <error message=\"%s\" type=\"%s\">\n"
+                                     (file-name-nondirectory test-report)
+                                     (ert-string-for-test-result
+                                      result
+                                      (ert-test-result-expected-p
+                                       test result)))
+                             (format "Test %s aborted with non-local exit\n"
+                                     (xml-escape-string
+                                      (symbol-name (ert-test-name test))))
+                             "      </error>\n"))
+                    ((not (ert-test-result-type-p
+                           result (ert-test-expected-result-type test)))
+                     (insert (format "      <failure message=\"%s\" type=\"%s\">\n"
+                                     (xml-escape-string
+                                      (string-trim
+                                       (ert-reason-for-test-result result)))
+                                     (ert-string-for-test-result
+                                      result
+                                      (ert-test-result-expected-p
+                                       test result)))
+                             (xml-escape-string
+                              (string-trim
+                               (ert-reason-for-test-result result)))
+                             "\n"
+                             "      </failure>\n")))
                    (unless (zerop (length (ert-test-result-messages result)))
                      (insert "      <system-out>\n"
                              (xml-escape-string
@@ -1617,21 +1632,41 @@ the tests)."
   "Write a JUnit summary test report, generated from LOGFILES."
   (let ((report (file-name-with-extension
                  (getenv "EMACS_TEST_JUNIT_REPORT") "xml"))
-        (tests 0) (failures 0) (skipped 0) (time 0) (id 0))
+        (tests 0) (errors 0) (failures 0) (skipped 0) (time 0) (id 0))
     (with-temp-file report
       (dolist (logfile logfiles)
-        (let ((test-file (file-name-with-extension logfile "xml")))
-          (when (file-readable-p test-file)
-            (insert-file-contents-literally test-file)
+        (let ((test-report (file-name-with-extension logfile "xml")))
+          (if (not (file-readable-p test-report))
+              (let ((logfile (file-name-with-extension logfile "log")))
+                (insert (format "  <testsuite id=\"%s\" name=\"%s\" tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\" timestamp=\"%s\">\n"
+                                id test-report
+                                (ert--format-time-iso8601 (current-time))))
+                (insert (format "    <testcase name=\"Test report missing %s\" status=\"error\" time=\"0\">\n"
+                                (file-name-nondirectory test-report)))
+                (insert (format "      <error message=\"Test report missing %s\" type=\"error\">\n"
+                                (file-name-nondirectory test-report)))
+                (when (file-readable-p logfile)
+                  (insert (xml-escape-string
+                           (with-temp-buffer
+                             (insert-file-contents-literally logfile)
+                             (buffer-string)))))
+                (insert "      </error>\n"
+                        "    </testcase>\n"
+                        "  </testsuite>\n")
+                (cl-incf errors 1)
+                (cl-incf id 1))
+
+            (insert-file-contents-literally test-report)
             (when (looking-at-p
                    (regexp-quote "<?xml version=\"1.0\" encoding=\"utf-8\"?>"))
               (delete-region (point) (line-beginning-position 2)))
             (when (looking-at
-                   "<testsuites name=\".+\" tests=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">")
+                   "<testsuites name=\".+\" tests=\"\\(.+\\)\" errors=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">")
               (cl-incf tests (string-to-number (match-string 1)))
-              (cl-incf failures  (string-to-number (match-string 2)))
-              (cl-incf skipped (string-to-number (match-string 3)))
-              (cl-incf time (string-to-number (match-string 4)))
+              (cl-incf errors  (string-to-number (match-string 2)))
+              (cl-incf failures  (string-to-number (match-string 3)))
+              (cl-incf skipped (string-to-number (match-string 4)))
+              (cl-incf time (string-to-number (match-string 5)))
               (delete-region (point) (line-beginning-position 2)))
             (when (looking-at "  <testsuite id=\"\\(0\\)\"")
               (replace-match (number-to-string id) nil nil nil 1)
@@ -1639,16 +1674,17 @@ the tests)."
             (goto-char (point-max))
             (beginning-of-line 0)
             (when (looking-at-p "</testsuites>")
-              (delete-region (point) (line-beginning-position 2)))
-            (narrow-to-region (point-max) (point-max)))))
+              (delete-region (point) (line-beginning-position 2))))
+
+          (narrow-to-region (point-max) (point-max))))
 
       (insert "</testsuites>\n")
       (widen)
       (goto-char (point-min))
       (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
-      (insert (format "<testsuites name=\"%s\" tests=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+      (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
                       (file-name-nondirectory report)
-                      tests failures skipped time)))))
+                      tests errors failures skipped time)))))
 
 (defun ert-summarize-tests-batch-and-exit (&optional high)
   "Summarize the results of testing.
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
new file mode 100644
index 00000000000..17c9384134c
--- /dev/null
+++ b/lisp/emacs-lisp/multisession.el
@@ -0,0 +1,439 @@
+;;; multisession.el --- Multisession storage for variables  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'sqlite)
+(require 'url)
+(require 'tabulated-list)
+
+(defcustom multisession-storage 'files
+  "Storage method for multisession variables.
+Valid methods are `sqlite' and `files'."
+  :type '(choice (const :tag "SQLite" sqlite)
+                 (const :tag "Files" files))
+  :version "29.1"
+  :group 'files)
+
+(defcustom multisession-directory (expand-file-name "multisession/"
+                                                    user-emacs-directory)
+  "Directory to store multisession variables."
+  :type 'file
+  :version "29.1"
+  :group 'files)
+
+;;;###autoload
+(defmacro define-multisession-variable (name initial-value &optional doc
+                                             &rest args)
+  "Make NAME into a multisession variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-multisession'."
+  (declare (indent defun))
+  (unless (plist-get args :package)
+    (setq args (nconc (list :package
+                            (replace-regexp-in-string "-.*" ""
+                                                      (symbol-name name)))
+                      args)))
+  `(defvar ,name
+     (make-multisession :key ,(symbol-name name)
+                        :initial-value ,initial-value
+                        ,@args)
+     ,@(list doc)))
+
+(defconst multisession--unbound (make-symbol "unbound"))
+
+(cl-defstruct (multisession
+               (:constructor nil)
+               (:constructor multisession--create)
+               (:conc-name multisession--))
+  "A persistent variable that will live across Emacs invocations."
+  key
+  (initial-value nil)
+  package
+  (storage multisession-storage)
+  (synchronized nil)
+  (cached-value multisession--unbound)
+  (cached-sequence 0))
+
+(cl-defun make-multisession (&key key initial-value package synchronized
+                                  storage)
+  "Create a multisession object."
+  (unless package
+    (error "No package for the multisession object"))
+  (unless key
+    (error "No key for the multisession object"))
+  (unless (stringp package)
+    (error "The package has to be a string"))
+  (unless (stringp key)
+    (error "The key has to be a string"))
+  (multisession--create
+   :key key
+   :synchronized synchronized
+   :initial-value initial-value
+   :package package
+   :storage (or storage multisession-storage)))
+
+(defun multisession-value (object)
+  "Return the value of the multisession OBJECT."
+  (if (null user-init-file)
+      ;; If we don't have storage, then just return the value from the
+      ;; object.
+      (if (eq (multisession--cached-value object) multisession--unbound)
+          (multisession--initial-value object)
+        (multisession--cached-value object))
+    ;; We have storage, so we update from storage.
+    (multisession-backend-value (multisession--storage object) object)))
+
+(defun multisession--set-value (object value)
+  "Set the stored value of OBJECT to VALUE."
+  (if (null user-init-file)
+      ;; We have no backend, so just store the value.
+      (setf (multisession--cached-value object) value)
+    ;; We have a backend.
+    (multisession--backend-set-value (multisession--storage object)
+                                     object value)))
+
+(defun multisession-delete (object)
+  "Delete OBJECT from the backend storage."
+  (multisession--backend-delete (multisession--storage object) object))
+
+(gv-define-simple-setter multisession-value multisession--set-value)
+
+;; SQLite Backend
+
+(declare-function sqlite-execute "sqlite.c")
+(declare-function sqlite-select "sqlite.c")
+(declare-function sqlite-open "sqlite.c")
+(declare-function sqlite-pragma "sqlite.c")
+(declare-function sqlite-transaction "sqlite.c")
+(declare-function sqlite-commit "sqlite.c")
+
+(defvar multisession--db nil)
+
+(defun multisession--ensure-db ()
+  (unless multisession--db
+    (let* ((file (expand-file-name "sqlite/multisession.sqlite"
+                                   multisession-directory))
+           (dir (file-name-directory file)))
+      (unless (file-exists-p dir)
+        (make-directory dir t))
+      (setq multisession--db (sqlite-open file)))
+    (with-sqlite-transaction multisession--db
+      ;; Use a write-ahead-log (available since 2010), which makes
+      ;; writes a lot faster.
+      (sqlite-pragma multisession--db "journal_mode = WAL")
+      (sqlite-pragma multisession--db "synchronous = NORMAL")
+      (unless (sqlite-select
+               multisession--db
+               "select name from sqlite_master where type = 'table' and name = 'multisession'")
+        ;; Tidy up the database automatically.
+        (sqlite-pragma multisession--db "auto_vacuum = FULL")
+        ;; Create the table.
+        (sqlite-execute
+         multisession--db
+         "create table multisession (package text not null, key text not null, sequence number not null default 1, value text not null)")
+        (sqlite-execute
+         multisession--db
+         "create unique index multisession_idx on multisession (package, key)")))))
+
+(cl-defmethod multisession-backend-value ((_type (eql sqlite)) object)
+  (multisession--ensure-db)
+  (let ((id (list (multisession--package object)
+                  (multisession--key object))))
+    (cond
+     ;; We have no value yet; check the database.
+     ((eq (multisession--cached-value object) multisession--unbound)
+      (let ((stored
+             (car
+              (sqlite-select
+               multisession--db
+               "select value, sequence from multisession where package = ? and key = ?"
+               id))))
+        (if stored
+            (let ((value (car (read-from-string (car stored)))))
+              (setf (multisession--cached-value object) value
+                    (multisession--cached-sequence object) (cadr stored))
+              value)
+          ;; Nothing; return the initial value.
+          (multisession--initial-value object))))
+     ;; We have a value, but we want to update in case some other
+     ;; Emacs instance has updated.
+     ((multisession--synchronized object)
+      (let ((stored
+             (car
+              (sqlite-select
+               multisession--db
+               "select value, sequence from multisession where sequence > ? and package = ? and key = ?"
+               (cons (multisession--cached-sequence object) id)))))
+        (if stored
+            (let ((value (car (read-from-string (car stored)))))
+              (setf (multisession--cached-value object) value
+                    (multisession--cached-sequence object) (cadr stored))
+              value)
+          ;; Nothing, return the cached value.
+          (multisession--cached-value object))))
+     ;; Just return the cached value.
+     (t
+      (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql sqlite))
+                                               object value)
+  (catch 'done
+    (let ((i 0))
+      (while (< i 10)
+        (condition-case nil
+            (throw 'done (multisession--set-value-sqlite object value))
+          (sqlite-locked-error
+           (setq i (1+ i))
+           (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+      (signal 'sqlite-locked-error "Database is locked"))))
+
+(defun multisession--set-value-sqlite (object value)
+  (multisession--ensure-db)
+  (with-sqlite-transaction multisession--db
+    (let ((id (list (multisession--package object)
+                    (multisession--key object)))
+          (pvalue
+           (let ((print-length nil)
+                 (print-circle t)
+                 (print-level nil))
+             (prin1-to-string value))))
+      (condition-case nil
+          (ignore (read-from-string pvalue))
+        (error (error "Unable to store unreadable value: %s" pvalue)))
+      (sqlite-execute
+       multisession--db
+       "insert into multisession(package, key, sequence, value) values(?, ?, 1, ?) on conflict(package, key) do update set sequence = sequence + 1, value = ?"
+       (append id (list pvalue pvalue)))
+      (setf (multisession--cached-sequence object)
+            (caar (sqlite-select
+                   multisession--db
+                   "select sequence from multisession where package = ? and key = ?"
+                   id)))
+      (setf (multisession--cached-value object) value))))
+
+(cl-defmethod multisession--backend-values ((_type (eql sqlite)))
+  (multisession--ensure-db)
+  (sqlite-select
+   multisession--db
+   "select package, key, value from multisession order by package, key"))
+
+(cl-defmethod multisession--backend-delete ((_type (eql sqlite)) object)
+  (sqlite-execute multisession--db
+                  "delete from multisession where package = ? and key = ?"
+                  (list (multisession--package object)
+                        (multisession--key object))))
+
+;; Files Backend
+
+(defun multisession--encode-file-name (name)
+  (url-hexify-string name))
+
+(defun multisession--update-file-value (file object)
+  (condition-case nil
+      (with-temp-buffer
+        (let* ((time (file-attribute-modification-time
+                      (file-attributes file)))
+               (coding-system-for-read 'utf-8))
+          (insert-file-contents file)
+          (let ((stored (read (current-buffer))))
+            (setf (multisession--cached-value object) stored
+                  (multisession--cached-sequence object) time)
+            stored)))
+    ;; If the file is contended (could happen with file locking in
+    ;; Windws) or unreadable, just return the current value.
+    (error
+     (if (eq (multisession--cached-value object) multisession--unbound)
+         (multisession--initial-value object)
+       (multisession--cached-value object)))))
+
+(defun multisession--object-file-name (object)
+  (expand-file-name
+   (concat "files/"
+           (multisession--encode-file-name (multisession--package object))
+           "/"
+           (multisession--encode-file-name (multisession--key object))
+           ".value")
+   multisession-directory))
+
+(cl-defmethod multisession-backend-value ((_type (eql files)) object)
+  (let ((file (multisession--object-file-name object)))
+    (cond
+     ;; We have no value yet; see whether it's stored.
+     ((eq (multisession--cached-value object) multisession--unbound)
+      (if (file-exists-p file)
+          (multisession--update-file-value file object)
+        ;; Nope; return the initial value.
+        (multisession--initial-value object)))
+     ;; We have a value, but we want to update in case some other
+     ;; Emacs instance has updated.
+     ((multisession--synchronized object)
+      (if (and (file-exists-p file)
+               (time-less-p (multisession--cached-sequence object)
+                            (file-attribute-modification-time
+                             (file-attributes file))))
+          (multisession--update-file-value file object)
+        ;; Nothing, return the cached value.
+        (multisession--cached-value object)))
+     ;; Just return the cached value.
+     (t
+      (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql files))
+                                               object value)
+  (let ((file (multisession--object-file-name object))
+        (time (current-time)))
+    ;; Ensure that the directory exists.
+    (let ((dir (file-name-directory file)))
+      (unless (file-exists-p dir)
+        (make-directory dir t)))
+    (with-temp-buffer
+      (let ((print-length nil)
+            (print-circle t)
+            (print-level nil))
+        (prin1 value (current-buffer)))
+      (goto-char (point-min))
+      (condition-case nil
+          (read (current-buffer))
+        (error (error "Unable to store unreadable value: %s" (buffer-string))))
+      ;; Write to a temp file in the same directory and rename to the
+      ;; file for somewhat better atomicity.
+      (let ((coding-system-for-write 'utf-8)
+            (create-lockfiles nil)
+            (temp (make-temp-name file)))
+        (write-region (point-min) (point-max) temp nil 'silent)
+        (set-file-times temp time)
+        (rename-file temp file t)))
+    (setf (multisession--cached-sequence object) time
+          (multisession--cached-value object) value)))
+
+(cl-defmethod multisession--backend-values ((_type (eql files)))
+  (mapcar (lambda (file)
+            (let ((bits (file-name-split file)))
+              (list (url-unhex-string (car (last bits 2)))
+                    (url-unhex-string
+                     (file-name-sans-extension (car (last bits))))
+                    (with-temp-buffer
+                      (let ((coding-system-for-read 'utf-8))
+                        (insert-file-contents file)
+                        (read (current-buffer)))))))
+          (directory-files-recursively
+           (expand-file-name "files" multisession-directory)
+           "\\.value\\'")))
+
+(cl-defmethod multisession--backend-delete ((_type (eql files)) object)
+  (let ((file (multisession--object-file-name object)))
+    (when (file-exists-p file)
+      (delete-file file))))
+
+;; Mode for editing.
+
+(defvar-keymap multisession-edit-mode-map
+  :parent tabulated-list-mode-map
+  "d" #'multisession-delete-value
+  "e" #'multisession-edit-value)
+
+(define-derived-mode multisession-edit-mode special-mode "Multisession"
+  "This mode lists all elements in the \"multisession\" database."
+  :interactive nil
+  (buffer-disable-undo)
+  (setq-local buffer-read-only t
+              truncate-lines t)
+  (setq tabulated-list-format
+        [("Package" 10)
+         ("Key" 30)
+         ("Value" 30)])
+  (setq-local revert-buffer-function #'multisession-edit-mode--revert))
+
+;;;###autoload
+(defun list-multisession-values (&optional choose-storage)
+  "List all values in the \"multisession\" database.
+If CHOOSE-STORAGE (interactively, the prefix), query for the
+storage method to list."
+  (interactive "P")
+  (let ((storage
+         (if choose-storage
+             (intern (completing-read "Storage method: " '(sqlite files) nil t))
+           multisession-storage)))
+    (pop-to-buffer (get-buffer-create (format "*Multisession %s*" storage)))
+    (multisession-edit-mode)
+    (setq-local multisession-storage storage)
+    (multisession-edit-mode--revert)
+    (goto-char (point-min))))
+
+(defun multisession-edit-mode--revert (&rest _)
+  (let ((inhibit-read-only t)
+        (id (get-text-property (point) 'tabulated-list-id)))
+    (erase-buffer)
+    (tabulated-list-init-header)
+    (setq tabulated-list-entries
+          (mapcar (lambda (elem)
+                    (list
+                     (cons (car elem) (cadr elem))
+                     (vector (car elem) (cadr elem)
+                             (string-replace "\n" "\\n"
+                                             (format "%s" (caddr elem))))))
+                  (multisession--backend-values multisession-storage)))
+    (tabulated-list-print t)
+    (goto-char (point-min))
+    (when id
+      (when-let ((match
+                  (text-property-search-forward 'tabulated-list-id id t)))
+        (goto-char (prop-match-beginning match))))))
+
+(defun multisession-delete-value (id)
+  "Delete the value at point."
+  (interactive (list (get-text-property (point) 'tabulated-list-id))
+               multisession-edit-mode)
+  (unless id
+    (error "No value on the current line"))
+  (unless (yes-or-no-p "Really delete this item? ")
+    (user-error "Not deleting"))
+  (multisession--backend-delete multisession-storage
+                                (make-multisession :package (car id)
+                                                   :key (cdr id)))
+  (let ((inhibit-read-only t))
+    (beginning-of-line)
+    (delete-region (point) (progn (forward-line 1) (point)))))
+
+(defun multisession-edit-value (id)
+  "Edit the value at point."
+  (interactive (list (get-text-property (point) 'tabulated-list-id))
+               multisession-edit-mode)
+  (unless id
+    (error "No value on the current line"))
+  (let* ((object (make-multisession
+                  :package (car id)
+                  :key (cdr id)
+                  :storage multisession-storage))
+         (value (multisession-value object)))
+    (setf (multisession-value object)
+          (car (read-from-string
+                (read-string "New value: " (prin1-to-string value))))))
+  (multisession-edit-mode--revert))
+
+(provide 'multisession)
+
+;;; multisession.el ends here