diff options
| -rw-r--r-- | ChangeLog | 195 | ||||
| -rw-r--r-- | Makefile | 26 | ||||
| -rw-r--r-- | devbook-mode.el | 28 | ||||
| -rw-r--r-- | ebuild-mode-keywords.el | 40 | ||||
| -rw-r--r-- | ebuild-mode.el | 314 | ||||
| -rw-r--r-- | ebuild-mode.texi | 59 | ||||
| -rw-r--r-- | gentoo-newsitem-mode.el | 10 | ||||
| -rw-r--r-- | glep-mode.el | 10 | ||||
| -rwxr-xr-x | keyword-generation.sh | 2 | ||||
| -rw-r--r-- | test/devbook-mode-tests.el | 72 | ||||
| -rw-r--r-- | test/ebuild-mode-tests.el | 185 | ||||
| -rw-r--r-- | test/gentoo-newsitem-mode-tests.el | 93 | ||||
| -rw-r--r-- | test/glep-mode-tests.el | 65 | ||||
| -rw-r--r-- | test/xemacs-test-wrapper.el | 52 |
14 files changed, 925 insertions, 226 deletions
@@ -1,3 +1,198 @@ +2024-10-14 Ulrich Müller <ulm@gentoo.org> + + * ebuild-mode.el: + * test/ebuild-mode-tests.el: Avoid e as variable name because some + Emacs versions define it as a global constant for Euler's number. + +2024-10-12 Ulrich Müller <ulm@gentoo.org> + + * devbook-mode.el (rng-loc): Require. + (devbook-schema-file-name): New variable. + (devbook-locate-schema-file): New function. + (devbook-mode): Call it unless we already have a schema. + + * ebuild-mode.el (ebuild-mode-tabify): Do not let-bind + tabify-regexp because it is a special variable. + (ebuild-run-command): Ditto for shell-command. + * ebuild-mode.el: + * glep-mode.el: + * test/ebuild-mode-tests.el: Use unhyphenated names for lexical + variables throughout, in order not to accidentally override any + special variables. + +2024-10-08 Ulrich Müller <ulm@gentoo.org> + + * ebuild-mode.el (ebuild-mode-arch-stable-list): Don't fall back + to profiles.desc to determine whether an arch has stable keywords. + + * Makefile (EMACSFLAGS): Use single hyphen for compatibility. + + * ebuild-mode.el (ebuild-mode-collect-and-split): Preserve order. + (ebuild-mode-font-lock-keywords): Add docstring. + * test/ebuild-mode-tests.el (ebuild-mode-test-collect-and-split): + Update. + (ebuild-mode-test-font-lock-keywords): New test. + +2024-10-05 Ulrich Müller <ulm@gentoo.org> + + * ebuild-mode.texi (ebuild-repo-mode): Document the bug-reference + feature. + (devbook-mode): Add cross reference to the nXML Mode manual. + + * ebuild-mode.el (ebuild-repo-mode): Don't set the bug-reference-* + variables if ebuild-mode-enable-bug-reference is nil. Test for + bug-reference-prog-mode at run time instead of compile time. + +2024-09-30 Ulrich Müller <ulm@gentoo.org> + + * gentoo-newsitem-mode.el (gentoo-newsitem-mode): Don't set + font-lock-defaults. + (gentoo-newsitem-add-font-lock): New function. + (gentoo-newsitem-mode-hook): Add it to the mode hook. + + * test/gentoo-newsitem-mode-tests.el (gentoo-newsitem-test-input) + (gentoo-newsitem-test-font-lock, gentoo-newsitem-test-skeleton) + (gentoo-newsitem-test-keybindings): Shorten names. + + * test/ebuild-mode-tests.el (ebuild-mode-test-run-with-fixed-time): + * test/glep-mode-tests.el (glep-mode-test-run-with-fixed-time): + Use func-arity to detect the calling convention for encode-time. + + * test/ebuild-mode-tests.el (cl-letf, cl-letf*): Enclose their + definition in eval-when-compile. + (ebuild-mode-test-font-lock): Call font-lock-fontify-region + instead of font-lock-fontify-buffer. This is silent and also + avoids the noninteractive trickery. + * test/gentoo-newsitem-mode-tests.el (cl-letf, cl-letf*) + (gentoo-newsitem-mode-test-font-lock): Ditto. + (gentoo-newsitem-mode-test-run-silently): Remove. + + * test/ebuild-mode-tests.el (ebuild-mode-test-skeleton): + Remove unnecessary ebuild-mode-test-run-silently. + * test/gentoo-newsitem-mode-tests.el + (gentoo-newsitem-mode-test-skeleton): Remove unnecessary + gentoo-newsitem-mode-test-run-silently. + +2024-09-28 Ulrich Müller <ulm@gentoo.org> + + * test/ebuild-mode-tests.el: + * test/gentoo-newsitem-mode-tests.el: Drop redundant XEmacs + conditionals. + + * test/xemacs-test-wrapper.el (skip-unless): New function. + (test-skipped): New error symbol. + (ert-deftest): Handle it. + + * ebuild-mode.el (ebuild-mode-enable-bug-reference): + New custom variable. + (ebuild-mode-bug-regexp, ebuild-mode-bug-url-format): + New variables. + (ebuild-repo-mode): Conditionally enable bug-reference-prog-mode. + * test/ebuild-mode-tests.el (ebuild-mode-test-bug-url): New test. + + * ebuild-mode.el (ebuild-repo-mode): Define the nxml-* variables + instead of requiring nxml-mode at compile time. + +2024-09-25 Ulrich Müller <ulm@gentoo.org> + + * keyword-generation.sh (OBSOLETE): Update. + + * test/ebuild-mode-tests.el (ebuild-mode-test-time-string): + Run with fixed time. + + * ebuild-mode.el (ebuild-mode-arch-list): Remove ia64. + +2024-09-10 Ulrich Müller <ulm@gentoo.org> + + * test/ebuild-mode-tests.el (ebuild-mode-test-update-copyright): + Actually run ebuild-mode-update-copyright. + +2024-08-29 Ulrich Müller <ulm@gentoo.org> + + * Version 1.75 released. + + * test/ebuild-mode-tests.el (ebuild-mode-test-run-with-fixed-time): + * test/glep-mode-tests.el (glep-mode-test-run-with-fixed-time): + Use encode-time instead of date-to-time. Bug 938666. + +2024-08-28 Ulrich Müller <ulm@gentoo.org> + + * Version 1.74 released. + + * ebuild-mode-keywords.el (ebuild-mode-keywords-eclass): + Regenerated. + +2024-08-26 Ulrich Müller <ulm@gentoo.org> + + * ebuild-mode.el (ebuild-mode-eapi-list): Drop 6 from list of + supported EAPIs. + + * test/ebuild-mode-tests.el (ebuild-mode-test-input): New variable + and function. + (ebuild-mode-test-skeleton, ebuild-mode-test-keybindings): + New tests. + * test/glep-mode-tests.el (glep-mode-test-input): New variable and + function. + (glep-mode-test-skeleton, glep-mode-test-keybindings): New tests. + * test/gentoo-newsitem-mode-tests.el: + * test/devbook-mode-tests.el: New files. + * Makefile (DISTFILES, TESTS): Add them. + + * test/xemacs-test-wrapper.el (kill-emacs): Return a useful exit + status. + +2024-08-22 Ulrich Müller <ulm@gentoo.org> + + * test/ebuild-mode-tests.el (cl-letf, cl-letf*) + (ebuild-mode-test-run-with-fixed-time) + (ebuild-mode-test-run-silently, ebuild-mode-test-font-lock) + (ebuild-mode-test-unescape-string): Portability fixes for XEmacs. + * test/glep-mode-tests.el (glep-mode-test-run-with-fixed-time): + Sync from ebuild-mode-test-run-with-fixed-time. + * test/xemacs-test-wrapper.el: New file. + * Makefile (DISTFILES): Add xemacs-test-wrapper.el. + (ELCS, TESTS): Include only files that are actually supported by + the Emacs version. + (check): Make it work with XEmacs. + + * ebuild-mode.el (ebuild-repo-mode): Activate the menu in XEmacs. + Use positive condition for feature. + + * ebuild-mode.el (ebuild-mode-menu): Drop :active keyword because + the three-element vector form of menu items is more portable. + (ebuild-repo-mode-menu): Rename menu bar item to "Ebuild-Repo". + Replace :visible keyword by :included; XEmacs 21.4 doesn't know + the former. + + * ebuild-mode.el (ebuild-mode-update-copyright): Save match data, + replace-match in XEmacs 21.4 clobbers it. + +2024-08-20 Ulrich Müller <ulm@gentoo.org> + + * ebuild-mode.el (ebuild-mode-arch-stable-list): Use push. + + * ebuild-mode.el (ebuild-mode-collect-and-split): Don't copy the + element when creating a cons cell is enough. + * test/ebuild-mode-tests.el (ebuild-mode-test-collect-and-split): + Update. + +2024-08-19 Ulrich Müller <ulm@gentoo.org> + + * ebuild-mode.el: + * ebuild-mode-keywords.el: + * gentoo-newsitem-mode.el: + * glep-mode.el: + * devbook-mode.el: Doc fixes. + + * ebuild-mode.el (ebuild-run-command-*): Run the "clean" command + when a prefix argument is given. + * ebuild-mode.texi (ebuild-mode): Document it. + + * ebuild-mode.el (ebuild-mode-find-image-dir): New function. + (ebuild-mode-prefix-map, ebuild-mode-menu): Keybinding and + menu entry. + * ebuild-mode.texi (ebuild-mode): Document it. + 2024-08-16 Ulrich Müller <ulm@gentoo.org> * ebuild-mode.el (ebuild-run-command-*): Define functions @@ -6,18 +6,24 @@ PV = $(shell sed '/^;.*[Vv]ersion/!d;s/[^0-9.]*\([^ \t]*\).*/\1/;q' \ ebuild-mode.el) P = $(PN)-$(PV) -TESTS = test/ebuild-mode-tests.el test/glep-mode-tests.el +EMACS = emacs +EMACSFLAGS = -batch -q -no-site-file +BYTECOMPFLAGS = -eval "(add-to-list 'load-path nil)" + DISTFILES = ebuild-mode.el ebuild-mode-keywords.el devbook-mode.el \ gentoo-newsitem-mode.el glep-mode.el ebuild-mode.texi \ ChangeLog Makefile keyword-generation.sh \ - $(TESTS) + test/ebuild-mode-tests.el test/devbook-mode-tests.el \ + test/gentoo-newsitem-mode-tests.el test/glep-mode-tests.el \ + test/xemacs-test-wrapper.el -ELCS = ebuild-mode.elc devbook-mode.elc gentoo-newsitem-mode.elc glep-mode.elc +ELCS = ebuild-mode.elc gentoo-newsitem-mode.elc +TESTS = test/ebuild-mode-tests.el test/gentoo-newsitem-mode-tests.el INFOFILES = ebuild-mode.info - -EMACS = emacs -EMACSFLAGS = -batch -q --no-site-file -BYTECOMPFLAGS = -eval "(add-to-list 'load-path nil)" +ifeq ($(findstring xemacs,$(EMACS)),) + ELCS += devbook-mode.elc glep-mode.elc + TESTS += test/devbook-mode-tests.el test/glep-mode-tests.el +endif .PHONY: all keywords check dist clean @@ -34,8 +40,14 @@ keywords: ./keyword-generation.sh check: +ifeq ($(findstring xemacs,$(EMACS)),) $(EMACS) $(EMACSFLAGS) $(BYTECOMPFLAGS) $(patsubst %,-l %,$(TESTS)) \ -f ert-run-tests-batch-and-exit +else + $(EMACS) $(EMACSFLAGS) $(BYTECOMPFLAGS) \ + -eval "(add-to-list 'load-path \"test\")" \ + -l xemacs-test-wrapper -f batch-test-emacs $(TESTS) +endif dist: $(DISTFILES) tar -cJf $(P).tar.xz --transform='s%^%$(P)/%' $^ diff --git a/devbook-mode.el b/devbook-mode.el index dee4c24..622f2ac 100644 --- a/devbook-mode.el +++ b/devbook-mode.el @@ -4,7 +4,7 @@ ;; Author: Ulrich Müller <ulm@gentoo.org> ;; Maintainer: <emacs@gentoo.org> -;; Keywords: wp, languages +;; Keywords: text, languages ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -24,9 +24,31 @@ ;;; Code: (require 'nxml-mode) +(require 'rng-loc) (require 'easymenu) (require 'skeleton) +(defvar devbook-schema-file-name "devbook.rnc") + +(defun devbook-locate-schema-file (&optional noerror) + "Look for a devbook schema file in any parent directory. +If successful, load it as the schema for the current buffer. +Otherwise, signal an error, or return nil if the optional argument +NOERROR is non-nil." + (interactive "P") + (let* ((dir (and buffer-file-name + (locate-dominating-file buffer-file-name + devbook-schema-file-name))) + (file (and dir (expand-file-name devbook-schema-file-name dir)))) + (cond (file + (condition-case err + (progn + (rng-set-schema-file-1 file) + (rng-what-schema)) + (error (unless noerror (signal (car err) (cdr err)))))) + (noerror nil) + (t (error "Schema file %s not found" devbook-schema-file-name))))) + ;;;###autoload (define-derived-mode devbook-mode nxml-mode "DevBook" "Major mode for editing the Gentoo Devmanual." @@ -39,7 +61,9 @@ ;; *** FIXME *** The style guide says no indentation, except inside ;; <tr>, <ul>, <ol> and <dl>, where it must be 2 spaces. There is no ;; easy way to achieve this, so set to 0 which is right more often. - (set (make-local-variable 'nxml-child-indent) 0)) + (set (make-local-variable 'nxml-child-indent) 0) + (unless rng-current-schema-file-name + (devbook-locate-schema-file t))) (define-skeleton devbook-insert-skeleton "Insert a skeleton for a DevBook XML document." diff --git a/ebuild-mode-keywords.el b/ebuild-mode-keywords.el index f7f5e9f..19e346a 100644 --- a/ebuild-mode-keywords.el +++ b/ebuild-mode-keywords.el @@ -1,4 +1,4 @@ -;;; ebuild-mode-keywords.el -*-lexical-binding:t-*- +;;; ebuild-mode-keywords.el --- keywords for font-lock -*-lexical-binding:t-*- ;; Copyright 2006-2024 Gentoo Authors @@ -83,7 +83,7 @@ (defvar ebuild-mode-keywords-warn ;; warn about "which" usage, see <200703121910.26067.vapier@gentoo.org> - ;; https://archives.gentoo.org/gentoo-dev/message/e04d4db72572dd5fec48e87c6b18c525 + ;; https://public-inbox.gentoo.org/gentoo-dev/200703121910.26067.vapier@gentoo.org/ '(("which") font-lock-warning-face)) @@ -228,15 +228,17 @@ ;; dune "dune-compile" "dune-install" "dune-release" "dune-test" "dune_src_compile" "dune_src_install" "dune_src_test" "edune" - ;; eapi7-ver - "ver_cut" "ver_rs" "ver_test" ;; eapi8-dosym "dosym8" ;; ecm "ecm_pkg_postinst" "ecm_pkg_postrm" "ecm_pkg_preinst" "ecm_pkg_pretend" "ecm_pkg_setup" "ecm_punt_bogus_dep" "ecm_punt_kf_module" - "ecm_punt_qt_module" "ecm_src_compile" "ecm_src_configure" - "ecm_src_install" "ecm_src_prepare" "ecm_src_test" + "ecm_punt_po_install" "ecm_punt_qt_module" "ecm_src_compile" + "ecm_src_configure" "ecm_src_install" "ecm_src_prepare" "ecm_src_test" + ;; ecm-common + "ecm-common-check_deps" "ecm-common_inject_heredoc" + "ecm-common_pkg_setup" "ecm-common_src_configure" + "ecm-common_src_prepare" ;; edo "edo" "edob" ;; edos2unix @@ -349,6 +351,18 @@ "gstreamer_system_library" "gstreamer_system_package" "multilib_src_compile" "multilib_src_configure" "multilib_src_install" "multilib_src_test" + ;; guile + "guile_copy_sources" "guile_for_best_impl" "guile_foreach_impl" + "guile_merge_roots" "guile_pkg_setup" "guile_src_compile" + "guile_src_configure" "guile_src_install" "guile_src_prepare" + "guile_src_test" + ;; guile-single + "guile-single_pkg_setup" "guile-single_src_install" + "guile-single_src_prepare" "guile_gen_cond_dep" + ;; guile-utils + "guile_bump_sources" "guile_check_compat" "guile_create_temporary_config" + "guile_export" "guile_filter_pkgconfig_path" "guile_generate_depstrings" + "guile_set_common_vars" "guile_unstrip_ccache" ;; haskell-cabal "cabal-bootstrap" "cabal-build" "cabal-configure" "cabal-constraint" "cabal-copy" "cabal-die-if-nonempty" "cabal-export-dist-libs" @@ -721,11 +735,10 @@ "systemd_dounit" "systemd_douserunit" "systemd_enable_ntpunit" "systemd_enable_service" "systemd_get_sleepdir" "systemd_get_systemgeneratordir" "systemd_get_systempresetdir" - "systemd_get_systemunitdir" "systemd_get_unitdir" - "systemd_get_userunitdir" "systemd_get_utildir" "systemd_install_dropin" - "systemd_install_serviced" "systemd_is_booted" "systemd_newunit" - "systemd_newuserunit" "systemd_reenable" "systemd_update_catalog" - "systemd_with_unitdir" "systemd_with_utildir" + "systemd_get_systemunitdir" "systemd_get_userunitdir" + "systemd_get_utildir" "systemd_install_dropin" "systemd_install_serviced" + "systemd_is_booted" "systemd_newunit" "systemd_newuserunit" + "systemd_reenable" "systemd_update_catalog" ;; texlive-common "dobin_texmf_scripts" "efmtutil-sys" "etexlinks" "etexmf-update" "texlive-common_append_to_src_uri" "texlive-common_do_symlinks" @@ -783,8 +796,9 @@ "tc-getSTRIP" "tc-getTARGET_CPP" "tc-has-64bit-time_t" "tc-has-tls" "tc-is-clang" "tc-is-cross-compiler" "tc-is-gcc" "tc-is-lto" "tc-is-softfloat" "tc-is-static-only" "tc-ld-disable-gold" - "tc-ld-force-bfd" "tc-ld-is-gold" "tc-ld-is-lld" "tc-ninja_magic_to_arch" - "tc-stack-grows-down" "tc-tuple-is-softfloat" + "tc-ld-force-bfd" "tc-ld-is-bfd" "tc-ld-is-gold" "tc-ld-is-lld" + "tc-ld-is-mold" "tc-ninja_magic_to_arch" "tc-stack-grows-down" + "tc-tuple-is-softfloat" ;; tree-sitter-grammar "tree-sitter-grammar_src_compile" "tree-sitter-grammar_src_configure" "tree-sitter-grammar_src_install" "tree-sitter-grammar_src_prepare" diff --git a/ebuild-mode.el b/ebuild-mode.el index e4cbfb0..589fdaa 100644 --- a/ebuild-mode.el +++ b/ebuild-mode.el @@ -7,7 +7,7 @@ ;; Christian Faulhammer <fauli@gentoo.org> ;; Ulrich Müller <ulm@gentoo.org> ;; Maintainer: <emacs@gentoo.org> -;; Version: 1.73 +;; Version: 1.75 ;; Keywords: languages, processes ;; This file is free software: you can redistribute it and/or modify @@ -68,9 +68,9 @@ :group 'ebuild) (defcustom ebuild-mode-eapi-list - '("6" "7" "8") + '("7" "8") "List of supported EAPIs. -The most recent EAPI must be listed last." +The most recent EAPI is listed last." :type '(repeat string) :group 'ebuild) @@ -101,6 +101,11 @@ If nil, don't update." :type 'boolean :group 'ebuild) +(defcustom ebuild-mode-enable-bug-reference t + "If non-nil, enable `bug-reference-prog-mode' in `ebuild-repo-mode'." + :type 'boolean + :group 'ebuild) + (defcustom ebuild-mode-xml-indent-tabs nil "If non-nil, use tab characters for indenting of XML. If nil, use two spaces." @@ -111,7 +116,7 @@ If nil, use two spaces." (unless (fboundp 'ansi-color-compilation-filter) '("NO_COLOR=1")) "List of additional environment variables for subprocesses. -Each element should be a string of the form NAME=VALUE. This will +Each element should be a string of the form NAME=VALUE. This will be prepended to `process-environment' when calling a subprocess." :type '(repeat string) :group 'ebuild) @@ -139,39 +144,25 @@ Returns non-nil if A is less than B by Gentoo keyword ordering." (sort (split-string (buffer-string)) #'ebuild-mode-arch-lessp)) (file-error nil)) ;; could not read architectures from repository, so fall back to default - '("alpha" "amd64" "arm" "arm64" "hppa" "ia64" "loong" "m68k" "mips" + '("alpha" "amd64" "arm" "arm64" "hppa" "loong" "m68k" "mips" "ppc" "ppc64" "riscv" "s390" "sparc" "x86")) "List of architectures.") (defvar ebuild-mode-arch-stable-list (or - ;; try to read arches.desc (GLEP 72) first, then profiles.desc + ;; try to read arches.desc (GLEP 72) first (condition-case nil (with-temp-buffer (insert-file-contents-literally (concat ebuild-mode-portdir "/profiles/arches.desc")) - (let (arch archs) + (let (archs) (while (re-search-forward "^[ \t]*\\([^ \t\n#]+\\)[ \t]+\\(stable\\|transitional\\)\\>" nil t) - (setq arch (match-string 1)) - (and (not (member arch archs)) - (member arch ebuild-mode-arch-list) - (setq archs (cons arch archs)))) - (sort archs #'ebuild-mode-arch-lessp))) - (file-error nil)) - (condition-case nil - (with-temp-buffer - (insert-file-contents-literally - (concat ebuild-mode-portdir "/profiles/profiles.desc")) - (let (arch archs) - (while (re-search-forward - "^[ \t]*\\([^ \t\n#]+\\)[ \t]+[^ \t\n#]+[ \t]+stable\\>" - nil t) - (setq arch (match-string 1)) - (and (not (member arch archs)) - (member arch ebuild-mode-arch-list) - (setq archs (cons arch archs)))) + (let ((arch (match-string 1))) + (and (not (member arch archs)) + (member arch ebuild-mode-arch-list) + (push arch archs)))) (sort archs #'ebuild-mode-arch-lessp))) (file-error nil)) ;; fall back to list of all architectures @@ -248,8 +239,9 @@ Returns non-nil if A is less than B by Gentoo keyword ordering." '("cache" "ci" "replay" "scan" "show") "List of pkgcheck sub-commands.") -;; suppress byte-compiler warning in XEmacs +;; suppress byte-compiler warnings in XEmacs (defvar ebuild-mode-menu) +(defvar ebuild-repo-mode-menu) ;;; Compatibility code. @@ -258,6 +250,7 @@ Returns non-nil if A is less than B by Gentoo keyword ordering." (unless (fboundp 'static-if) (defmacro static-if (cond then &rest else) ; from APEL "Like `if', but evaluate COND at compile time." + (declare (indent 2)) (if (eval cond) then `(progn ,@else))) @@ -290,25 +283,27 @@ Compatibility function for XEmacs." "For alist SRC, collect elements with equal cdr and concat their cars. Optional argument LIMIT specifies the maximum length for the car of the elements." - (let (dst e) - (dolist (c src dst) - (setq e (rassoc (cdr c) dst)) - (cond - ((and e (or (not limit) - (<= (+ (length (car e)) (length (car c))) limit))) - ;; cdrs of new element C and previous element E are equal, - ;; and their combined length is below LIMIT => append to E - (setcar e (append (car e) (car c)))) - ((or (not limit) - (<= (length (car c)) limit)) - ;; new element C is small enough => push to DST - (setq dst (cons (copy-sequence c) dst))) - (t - ;; otherwise, split the new element into chunks of length LIMIT - (let ((cc (car c))) - (while cc - (setq dst (cons (cons (last cc limit) (cdr c)) dst)) - (setq cc (butlast cc limit))))))))) + (let (dst) + (dolist (c src) + (let ((d (rassoc (cdr c) dst))) + (cond + ((and d (or (not limit) + (<= (+ (length (car d)) (length (car c))) limit))) + ;; cdrs of new element C and previous element D are equal, + ;; and their combined length is below LIMIT => append to D + (setcar d (append (car d) (car c)))) + ((or (not limit) + (<= (length (car c)) limit)) + ;; new element C is small enough => push to DST + (push (cons (car c) (cdr c)) dst)) + (t + ;; otherwise, split the new element into pieces of length LIMIT + (let ((p (copy-sequence (car c)))) + (while p + (push (cons p (cdr c)) dst) + (and (setq p (nthcdr (1- limit) p)) + (setq p (prog1 (cdr p) (setcdr p nil)))))))))) + (nreverse dst))) ) (eval-when-compile @@ -322,8 +317,8 @@ of the elements." (regexp-opt (car x) t) (or (nth 3 x) "\\>")) (cadr x))) - ;; Emacs has a limit of 32 kbyte for the size of regular - ;; expressions. Unfortunately, this is a hard limit in Emacs' + ;; GNU Emacs has a limit of 32 KiB for the size of regular + ;; expressions. Unfortunately, this is a hard limit in the ;; C code, MAX_BUF_SIZE in regex.c, which cannot be increased. ;; Therefore, split the list into several parts with at most ;; 1000 keywords; this appears to keep the regexp size below @@ -338,7 +333,8 @@ of the elements." ebuild-mode-keywords-eclassdoc ebuild-mode-keywords-eclassdoc-warn ebuild-mode-keywords-eclass) - 1000)))) + 1000))) + "Expressions to highlight in `ebuild-mode'.") ;;; Mode definitions. @@ -347,19 +343,17 @@ of the elements." ;; We cannot use the following since XEmacs doesn't support tabify-regexp. ;;(let ((tabify-regexp "^\t* [ \t]+")) ;; (tabify (point-min) (point-max))) - (let ((tabify-regexp "^\t* [ \t]+") - (indent-tabs-mode t)) + (let ((indent-tabs-mode t)) (save-excursion (goto-char (point-min)) - (while (re-search-forward tabify-regexp nil t) - (let ((end-col (current-column)) - (beg-col (save-excursion (goto-char (match-beginning 0)) - (skip-chars-forward "\t") - (current-column)))) - (if (= (/ end-col tab-width) (/ beg-col tab-width)) - nil + (while (re-search-forward "^\t* [ \t]+" nil t) + (let ((end (current-column)) + (beg (save-excursion (goto-char (match-beginning 0)) + (skip-chars-forward "\t") + (current-column)))) + (unless (= (/ end tab-width) (/ beg tab-width)) (delete-region (match-beginning 0) (point)) - (indent-to end-col))))))) + (indent-to end))))))) (defun ebuild-mode-delete-trailing-whitespace () "Delete all the trailing spaces and tabs across the current buffer." @@ -382,33 +376,35 @@ of the elements." (save-excursion (goto-char (point-min)) (let ((case-fold-search nil) - (update-year (or (nlistp ebuild-mode-update-copyright) - (nth 0 ebuild-mode-update-copyright))) - (update-author (or (nlistp ebuild-mode-update-copyright) - (nth 1 ebuild-mode-update-copyright)))) + (updyear (or (nlistp ebuild-mode-update-copyright) + (nth 0 ebuild-mode-update-copyright))) + (updauth (or (nlistp ebuild-mode-update-copyright) + (nth 1 ebuild-mode-update-copyright)))) (when (re-search-forward ebuild-mode-copyright-regexp 400 t) - (if update-year - (let* ((y1 (string-to-number (match-string 1))) - (y2 (and (match-string 2) - (string-to-number (match-string 2)))) - (year (save-match-data (ebuild-mode-time-string "%Y"))) - (y (string-to-number year))) - (if y2 - ;; Update range of years - (cond ((or (> 1999 y1) (>= y1 y2) (> y2 y)) - ;; XEmacs wants 'warning instead of :warning, - ;; but nil always works (and defaults to :warning) + (if updyear + (save-match-data + (let* ((y1 (string-to-number (match-string 1))) + (y2 (and (match-string 2) + (string-to-number (match-string 2)))) + (year (save-match-data (ebuild-mode-time-string "%Y"))) + (y (string-to-number year))) + (if y2 + ;; Update range of years + (cond ((or (> 1999 y1) (>= y1 y2) (> y2 y)) + ;; XEmacs wants 'warning instead of :warning, + ;; but nil always works (and defaults to :warning) + (lwarn 'ebuild nil + "Suspicious range of copyright years: %d-%d" + y1 y2)) + ((/= y2 y) + (replace-match year t t nil 2))) + ;; Update single year and convert to range if necessary + (cond ((or (> 1999 y1) (> y1 y)) (lwarn 'ebuild nil - "Suspicious range of copyright years: %d-%d" - y1 y2)) - ((/= y2 y) - (replace-match year t t nil 2))) - ;; Update single year and convert to range if necessary - (cond ((or (> 1999 y1) (> y1 y)) - (lwarn 'ebuild nil "Suspicious copyright year: %d" y1)) - ((/= y1 y) - (replace-match (concat "\\1-" year) t nil nil 1)))))) - (if update-author + "Suspicious copyright year: %d" y1)) + ((/= y1 y) + (replace-match (concat "\\1-" year) t nil nil 1))))))) + (if updauth ;; Update default author in copyright notice (if (string-equal (match-string 3) "Gentoo Foundation") (replace-match "Gentoo Authors" t t nil 3))))))) @@ -469,14 +465,14 @@ If nil, `compilation-mode' will be used.") (or buffer-file-name (error "No file for this buffer")) (let* ((file (file-relative-name buffer-file-name)) - (shell-command (format "ebuild %s %s" file command)) + (cmd (format "ebuild %s %s" file command)) (process-environment (append ebuild-mode-process-environment process-environment)) ;;(compilation-mode-hook (lambda () (setq truncate-lines t))) (compilation-buffer-name-function (lambda (_mode) "*ebuild*"))) (static-if (featurep 'xemacs) - (compile shell-command) - (compile shell-command ebuild-log-buffer-mode)))) + (compile cmd) + (compile cmd ebuild-log-buffer-mode)))) ;; Define functions for all ebuild subcommands (dolist (command ebuild-commands-list) @@ -484,15 +480,18 @@ If nil, `compilation-mode' will be used.") ;; Backquote for XEmacs compatibility (no lexical binding). ;; Also, defalias in 21.4 accepts only two args, so the docstring ;; must be in the lambda form. - `(lambda () - ,(format "Run ebuild command \"%s\"." command) - (interactive) - (ebuild-run-command ,command)))) + `(lambda (&optional clean) + ,(format + "Run ebuild \"%s\" command, with output to a compilation buffer. +With prefix argument CLEAN, run the \"clean\" command first" + command) + (interactive "P") + (ebuild-run-command (concat (if clean "clean ") ,command))))) (define-derived-mode ebuild-compilation-mode compilation-mode "Compilation" "Like `compilation-mode' but with color support. Translates ANSI SGR control sequences into text properties (if the -Emacs version supports it). Variable `ansi-color-for-compilation-mode' +Emacs version supports it). Variable `ansi-color-for-compilation-mode' must be non-nil for this to have any effect." (if (fboundp 'ansi-color-compilation-filter) (add-hook 'compilation-filter-hook @@ -618,6 +617,18 @@ With prefix argument OTHER-WINDOW, visit the directory in another window." (find-file-other-window workdir) (find-file workdir)))) +(defun ebuild-mode-find-image-dir (&optional other-window) + "Visit the image directory (D) for the ebuild in this buffer. +With prefix argument OTHER-WINDOW, visit the directory in another window." + (interactive "P") + (let ((image (concat (ebuild-mode-get-builddir) "/image")) + (find-file-run-dired t)) + (unless (file-directory-p image) + (error "D=\"%s\" does not exist" image)) + (if other-window + (find-file-other-window image) + (find-file image)))) + (defun ebuild-mode-unescape-string (s &optional ansi-c) "Convert string S by expanding backslash escape sequences. With optional argument ANSI-C, expand a string with ANSI C escape @@ -626,13 +637,13 @@ sequences, instead of a simple double-quoted string. This function supports only escape sequences that can occur in the output of the \"declare -p\" Bash command." (let ((case-fold-search nil) - (decode-re (if ansi-c - "\\\\\\([abtnvfreE\\'\"?]\\|[0-7]\\{1,3\\}\\)" - "\\\\\\([$`\"\\\n]\\)")) - (decode-alist '((?a . ?\a) (?b . ?\b) (?t . ?\t) (?n . ?\n) (?v . ?\v) - (?f . ?\f) (?r . ?\r) (?e . ?\e) (?E . ?\e))) + (re (if ansi-c + "\\\\\\([abtnvfreE\\'\"?]\\|[0-7]\\{1,3\\}\\)" + "\\\\\\([$`\"\\\n]\\)")) + (map '((?a . ?\a) (?b . ?\b) (?t . ?\t) (?n . ?\n) (?v . ?\v) + (?f . ?\f) (?r . ?\r) (?e . ?\e) (?E . ?\e))) i) - (while (setq i (string-match decode-re s i)) + (while (setq i (string-match re s i)) (let* ((m (match-string 1 s)) (c (aref m 0)) (byte (cond ((and (>= c ?0) (< c ?8)) @@ -641,7 +652,7 @@ the output of the \"declare -p\" Bash command." (dotimes (j (length m)) (setq n (+ (* n 8) (- (aref m j) ?0)))) (logand n #xff))) - ((cdr (assq c decode-alist))) + ((cdr (assq c map))) (t c)))) (setq s (replace-match (static-if (fboundp 'byte-to-string) @@ -689,12 +700,12 @@ With prefix argument OTHER-WINDOW, visit the directory in another window." "Visit the build log for the ebuild in this buffer. With prefix argument OTHER-WINDOW, visit the directory in another window." (interactive "P") - (let ((build-log (concat (ebuild-mode-get-builddir) "/temp/build.log"))) - (unless (file-readable-p build-log) - (error "Cannot read file \"%s\"" build-log)) + (let ((file (concat (ebuild-mode-get-builddir) "/temp/build.log"))) + (unless (file-readable-p file) + (error "Cannot read file \"%s\"" file)) (if other-window - (find-file-other-window build-log) - (find-file build-log)) + (find-file-other-window file) + (find-file file)) ;; decode ANSI SGR control sequences if possible (tty-format.el) (and (assq 'ansi-colors format-alist) (save-excursion @@ -733,41 +744,39 @@ optional second argument NOERROR is non-nil." (save-excursion (goto-char (point-min)) (let ((case-fold-search nil) - (kw-string (mapconcat - (lambda (e) (concat (cdr e) (car e))) kw " "))) + (kwstring (mapconcat (lambda (x) (concat (cdr x) (car x))) + kw " "))) (cond ((not (re-search-forward ebuild-mode-arch-regexp nil t)) (unless noerror (error "No KEYWORDS assignment found"))) ((re-search-forward ebuild-mode-arch-regexp nil t) (unless noerror (error "More than one KEYWORDS assignment found"))) (t - (unless (string-equal kw-string (match-string 1)) - (replace-match kw-string t t nil 1))))))) + (unless (string-equal kwstring (match-string 1)) + (replace-match kwstring t t nil 1))))))) (defun ebuild-mode-modify-keywords (kw) - "Set keywords. KW is an alist of architectures and leaders." + "Set keywords. KW is an alist of architectures and leaders." (let ((keywords (ebuild-mode-get-keywords))) (dolist (k kw) (let* ((arch (car k)) (leader (cdr k)) - (old-k (assoc arch keywords))) + (oldk (assoc arch keywords))) (cond ;; remove keywords ((null leader) (setq keywords (and (not (string-equal arch "all")) - (delq old-k keywords)))) + (delq oldk keywords)))) ;; modify all non-masked keywords in the list ((string-equal arch "all") - (dolist (e keywords) - (and (or (equal (cdr e) "") - (equal (cdr e) "~")) - (member (car e) - (if (equal leader "") - ebuild-mode-arch-stable-list - ebuild-mode-arch-list)) - (setcdr e leader)))) + (dolist (j keywords) + (and (member (cdr j) '("" "~")) + (member (car j) (if (equal leader "") + ebuild-mode-arch-stable-list + ebuild-mode-arch-list)) + (setcdr j leader)))) ;; modify keyword - (old-k (setcdr old-k leader)) + (oldk (setcdr oldk leader)) ;; add keyword (t (setq keywords (cons k keywords)))))) (ebuild-mode-put-keywords @@ -791,7 +800,7 @@ architecture from `ebuild-mode-arch-list'." (defun ebuild-mode-ekeyword-complete (s predicate mode) "Completion function, to be used as second argument of `completing-read'. Return common substring of all completions of S for given PREDICATE. -MODE can be nil, t, or `lambda'. See documentation of `try-completion' +MODE can be nil, t, or `lambda'. See documentation of `try-completion' and `all-completions' for details." (string-match "^\\(.*\\s-\\)?\\(.*\\)$" s) (if (eq (car-safe mode) 'boundaries) ; GNU Emacs 23 @@ -819,7 +828,7 @@ and `all-completions' for details." (if (stringp c2) (concat s1 c2) c2)))) (defun ebuild-mode-ekeyword (keywords) - "Keyword manipulation. Accepts the same input format as ekeyword. + "Keyword manipulation. Accepts the same input format as ekeyword. KEYWORDS is a whitespace separated string containing the keywords that shall be manipulated." (interactive @@ -943,6 +952,22 @@ This will be added to the `write-contents-functions' hook." This excludes `comment-start'. See `ebuild-mode-insert-tag-line' for the format of the tag line.") +(defvar ebuild-mode-bug-regexp + "\\(\\(?:\\b[Bb]ug *[ #]\\|#\\)\\([0-9]\\{4,\\}\\)\\)" + "Regular expression matching bug references. +The format is the same as for `bug-reference-bug-regexp', which see.") + +(defvar ebuild-mode-bug-url-format + "https://bugs.gentoo.org/%s" + "Format used to turn a bug number into a URL. +The bug number is supplied as a string, so this should have a single %s. +See `bug-reference-url-format' for further details.") + +(defvar bug-reference-bug-regexp) ; bug-reference.el +(defvar bug-reference-url-format) +(defvar nxml-child-indent) ; nxml-mode.el +(defvar nxml-attribute-indent) + ;;;###autoload (define-minor-mode ebuild-repo-mode "Minor mode for files in an ebuild repository." @@ -951,17 +976,28 @@ for the format of the tag line.") (if (ignore-errors (check-coding-system 'utf-8-unix)) ;; utf-8-unix doesn't exist in XEmacs 21.4 (setq buffer-file-coding-system 'utf-8-unix)) - (static-if (not (featurep 'xemacs)) - (add-hook 'write-contents-functions - #'ebuild-repo-mode-before-save t t) - ;; make-local-hook gives a byte-compiler warning in GNU Emacs - (make-local-hook 'write-contents-hooks) - (add-hook 'write-contents-hooks + (static-if (featurep 'xemacs) + (progn + (easy-menu-add ebuild-repo-mode-menu) + ;; make-local-hook gives a byte-compiler warning in GNU Emacs + (make-local-hook 'write-contents-hooks) + (add-hook 'write-contents-hooks + #'ebuild-repo-mode-before-save t t)) + (add-hook 'write-contents-functions #'ebuild-repo-mode-before-save t t)) (unless (local-variable-p 'fill-column (current-buffer)) ; XEmacs wants 2 args (setq fill-column 72)) (unless (local-variable-p 'tab-width (current-buffer)) (setq tab-width 4)) + (when (and (fboundp 'bug-reference-prog-mode) + ebuild-mode-enable-bug-reference) + (unless (local-variable-p 'bug-reference-bug-regexp (current-buffer)) + (set (make-local-variable 'bug-reference-bug-regexp) + ebuild-mode-bug-regexp)) + (unless (local-variable-p 'bug-reference-url-format (current-buffer)) + (set (make-local-variable 'bug-reference-url-format) + ebuild-mode-bug-url-format)) + (bug-reference-prog-mode 1)) (cond ((derived-mode-p 'conf-unix-mode) (unless (local-variable-p 'paragraph-separate (current-buffer)) @@ -973,7 +1009,6 @@ for the format of the tag line.") (regexp-quote (concat comment-start)) ebuild-mode-tag-line-regexp)))) ((derived-mode-p 'nxml-mode) - (eval-when-compile (ignore-errors (require 'nxml-mode))) (unless (or (local-variable-p 'nxml-child-indent (current-buffer)) (local-variable-p 'nxml-attribute-indent (current-buffer))) (let ((indent (if ebuild-mode-xml-indent-tabs 4 2))) @@ -1009,7 +1044,7 @@ in a Gentoo profile." ebuild-mode-full-name ebuild-mode-mail-address (ebuild-mode-time-string "%Y-%m-%d")))) -;;; Keybindings. +;;; Key bindings. (defvar ebuild-mode-prefix-map (let ((map (make-sparse-keymap))) @@ -1019,6 +1054,7 @@ in a Gentoo profile." (define-key map "\C-c" #'ebuild-mode-run-pkgcheck) (define-key map "\C-w" #'ebuild-mode-find-workdir) (define-key map "\C-s" #'ebuild-mode-find-s) + (define-key map "\C-d" #'ebuild-mode-find-image-dir) (define-key map "\C-l" #'ebuild-mode-find-build-log) (define-key map "\C-k" #'ebuild-mode-keyword) (define-key map "\C-y" #'ebuild-mode-ekeyword) @@ -1048,22 +1084,24 @@ in a Gentoo profile." "Menu for `ebuild-mode'." `("Ebuild" ["Run ebuild command" ebuild-run-command - :active (eq major-mode 'ebuild-mode)] + (eq major-mode 'ebuild-mode)] ("ebuild commands" - :active (eq major-mode 'ebuild-mode) ,@(mapcar (lambda (c) - (vector c (intern (concat "ebuild-run-command-" c)))) + (vector c (intern (concat "ebuild-run-command-" c)) + '(eq major-mode 'ebuild-mode))) ebuild-commands-list)) ["Run pkgdev command" ebuild-mode-run-pkgdev] ["Run pkgcheck command" ebuild-mode-run-pkgcheck] ["Find working directory (WORKDIR)" ebuild-mode-find-workdir - :active (eq major-mode 'ebuild-mode)] + (eq major-mode 'ebuild-mode)] ["Find build directory (S)" ebuild-mode-find-s - :active (eq major-mode 'ebuild-mode)] + (eq major-mode 'ebuild-mode)] + ["Find image directory (D)" ebuild-mode-find-image-dir + (eq major-mode 'ebuild-mode)] ["Find build log" ebuild-mode-find-build-log - :active (eq major-mode 'ebuild-mode)] + (eq major-mode 'ebuild-mode)] ["Insert ebuild skeleton" ebuild-mode-insert-skeleton - :active (eq major-mode 'ebuild-mode)] + (eq major-mode 'ebuild-mode)] ["Set/unset keyword" ebuild-mode-keyword] ["Set/unset keywords (ekeyword syntax)" ebuild-mode-ekeyword] ["Mark all keywords as unstable" ebuild-mode-all-keywords-unstable] @@ -1071,9 +1109,9 @@ in a Gentoo profile." (easy-menu-define ebuild-repo-mode-menu ebuild-repo-mode-map "Menu for `ebuild-repo-mode'." - '("Ebuild" + '("Ebuild-Repo" ;; show the menu only for conf files - :visible (derived-mode-p 'conf-unix-mode) + :included (derived-mode-p 'conf-unix-mode) ["Insert package.mask tag line" ebuild-mode-insert-tag-line] ["Customize ebuild-mode" (customize-group 'ebuild)])) diff --git a/ebuild-mode.texi b/ebuild-mode.texi index 4784157..7c8cf36 100644 --- a/ebuild-mode.texi +++ b/ebuild-mode.texi @@ -26,7 +26,7 @@ later version published by the Free Software Foundation. @titlepage -@title ebuild-mode 1.73 +@title ebuild-mode 1.75 @subtitle Major mode for ebuilds and eclasses in Gentoo @author Christian Faulhammer @author Ulrich Müller @@ -84,7 +84,7 @@ eclasses. Missing highlighting should be reported on @code{https://bugs.gentoo.org/}. Generally all functionality is reachable through direct commands, -keybindings (described later) and menu entries, if the latter is +key bindings (described later) and menu entries, if the latter is activated. So every user has the choice for his/her preferred way of interfacing with Emacs. @@ -129,8 +129,9 @@ After choosing the action the architectures to handle need to be chosen. Tab completion is available for all possible architectures. Using the ekeyword syntax for the @code{ebuild-mode-ekeyword} command -(@kbd{C-c C-e C-y} as keybinding) is equal what you can pass as argument -to said utility from the @code{app-portage/gentoolkit-dev} package: +(@kbd{C-c C-e C-y} as key binding) is equal what you can pass as +argument to said utility from the @code{app-portage/gentoolkit-dev} +package: @table @code @item ^<arch> Remove the architecture entirely. @@ -146,7 +147,7 @@ It is possible to use @code{all} instead of an individual architecture which works on all currently available architectures for the ebuild. Handy for version/revision bumps is to mark all architectures from a -copied stable ebuild as testing. The keybinding @kbd{C-c C-e C-u} +copied stable ebuild as testing. The key binding @kbd{C-c C-e C-u} calling the @code{ebuild-mode-all-keywords-unstable} command can be used for this task. @@ -161,16 +162,18 @@ ebuild what actions are provided. Some common action (or subcommands) of the ebuild command can be executed via their own key sequences, all of them using @kbd{C-c C-e} followed by a letter. For example, the @code{unpack} action is bound -to @kbd{C-c C-e u}. Subcommands that don't have their own key sequence ---- but also those that do --- can be executed via the main +to @kbd{C-c C-e u}. With a prefix argument, the @code{clean} action +is executed first, additionally. Subcommands that don't have their own +key sequence --- but also those that do --- can be executed via the main @code{ebuild-run-command} bound to @kbd{C-c C-e C-e}, or via the menu. -The commands @code{ebuild-mode-find-workdir} and @code{ebuild-mode-find-s} -(bound to @kbd{C-c C-e C-w} and @kbd{C-c C-e C-s}, respectively) allow -to visit the working directory (@code{$@{WORKDIR@}}) and the temporary -build directory (@code{$@{S@}}) that belong to the ebuild in the current -buffer. With a prefix argument, the directory will be visited in -another window. +The commands @code{ebuild-mode-find-workdir}, @code{ebuild-mode-find-s} +and @code{ebuild-mode-find-image-dir} (bound to @kbd{C-c C-e C-w}, +@kbd{C-c C-e C-s} and @kbd{C-c C-e C-d}, respectively) allow to visit +the working directory (@code{$@{WORKDIR@}}), the temporary build +directory (@code{$@{S@}}) and the image directory (@code{$@{D@}}) that +belong to the ebuild in the current buffer. With a prefix argument, +the directory will be visited in another window. The command @code{ebuild-mode-find-build-log} (@kbd{C-c C-e C-l}) visits the @code{build.log} of the ebuild in the current buffer. With a prefix @@ -187,7 +190,7 @@ completion for subcommands is supported. Similarly, @kbd{C-c C-e C-c} calls @code{ebuild-mode-run-pkgcheck} which runs @command{pkgcheck}. -@section Keybindings +@section Key Bindings @table @kbd @item C-c C-e C-n Insert a skeleton ebuild contents, with prompts for desired eclass @@ -204,9 +207,11 @@ Run Portage's ebuild command, you are prompted for the phase you want. @item C-c C-e C-w Visit the working directory (@code{WORKDIR}) that belongs to the ebuild. @item C-c C-e C-s -Visit temporary build directory (@code{S}) that belongs to the ebuild. +Visit the temporary build directory (@code{S}). +@item C-c C-e C-d +Visit the image directory (@code{D}). @item C-c C-e C-l -Visit the @code{build.log} file that belongs to the ebuild. +Visit the @code{build.log} file. @item C-c C-e C-p Run a @command{pkgdev} command. @item C-c C-e C-c @@ -239,7 +244,7 @@ variable @code{ebuild-mode-xml-indent-tabs}. A value of nil (which is the default) means to use two spaces; non-nil means to use tab characters. -There is only one keybinding, namely @kbd{C-c -} which inserts a tag +There is only one key binding, namely @kbd{C-c -} which inserts a tag line with the user's name, e-mail address and date, in the format that is commonly used in @file{package.mask} and other files: @@ -250,13 +255,27 @@ is commonly used in @file{package.mask} and other files: The user's name and e-mail address can be customized with variables @code{ebuild-mode-full-name} and @code{ebuild-mode-mail-address}. +By default, @code{ebuild-repo-mode} will enable +@code{bug-reference-prog-mode}. This highlights references to bug +reports and makes it possible to follow them to the Gentoo bug tracker +(typically by pressing @kbd{C-c RET} or clicking @kbd{mouse-2} on the +highlighted text). For example, the reference @samp{bug #161121} in a +comment line would link to @url{https://bugs.gentoo.org/161121}. + +@xref{Bug Reference,,, emacs, The Emacs Editor} for further +explanation. + +You can disable bug references by setting the custom variable +@code{ebuild-mode-enable-bug-reference} to nil. + @node devbook-mode, gentoo-newsitem-mode, ebuild-eclass-mode, Top @chapter devbook-mode for the Gentoo Devmanual This is a very simple derived major mode for editing the Devmanual. Because the Devmanual is written in DevBook XML, this mode is derived from @code{nxml-mode} and inherits its syntax highlighting and editing -functions. A skeleton for a new Devmanual file can be inserted via -the @code{devbook-insert-skeleton} function bound to @kbd{C-c C-n}. +functions (@pxref{Top,,, nxml-mode, nXML Mode}). A skeleton for a new +Devmanual file can be inserted via the @code{devbook-insert-skeleton} +function bound to @kbd{C-c C-n}. It is recommended to install the @code{app-emacs/nxml-gentoo-schemas} package in addition, which will enable on-the-fly syntax validation. @@ -276,7 +295,7 @@ when doing so, but GLEP 42 stays the reference for the whole process. It gets automatically loaded when a file name matches the criteria of GLEP 42 (see there for details), but can also be invoked through the -@code{gentoo-newsitem-mode} function. The only available keybinding is +@code{gentoo-newsitem-mode} function. The only available key binding is @kbd{C-c C-n} which starts a skeleton assistant similar to the one available in @code{ebuild-mode}. All mandatory information are asked from the user so no item is forgotten. diff --git a/gentoo-newsitem-mode.el b/gentoo-newsitem-mode.el index 8cece4b..f356708 100644 --- a/gentoo-newsitem-mode.el +++ b/gentoo-newsitem-mode.el @@ -4,7 +4,7 @@ ;; Author: Ulrich Müller <ulm@gentoo.org> ;; Maintainer: <emacs@gentoo.org> -;; Keywords: wp +;; Keywords: text ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -50,12 +50,16 @@ ;;;###autoload (define-derived-mode gentoo-newsitem-mode text-mode "Newsitem" "Major mode for Gentoo GLEP 42 news items." - (make-local-variable 'font-lock-defaults) (if (featurep 'xemacs) (easy-menu-add gentoo-newsitem-mode-menu)) - (setq font-lock-defaults '(gentoo-newsitem-font-lock-keywords t)) (setq fill-column 72)) +(defun gentoo-newsitem-add-font-lock () + "Add `gentoo-newsitem-mode' font-lock keywords for the current buffer." + (font-lock-add-keywords nil gentoo-newsitem-font-lock-keywords)) + +(add-hook 'gentoo-newsitem-mode-hook #'gentoo-newsitem-add-font-lock) + (define-skeleton gentoo-newsitem-insert-skeleton "Insert a skeleton for a Gentoo GLEP 42 news item." nil diff --git a/glep-mode.el b/glep-mode.el index 672c20a..48590a8 100644 --- a/glep-mode.el +++ b/glep-mode.el @@ -4,7 +4,7 @@ ;; Author: Ulrich Müller <ulm@gentoo.org> ;; Maintainer: <emacs@gentoo.org> -;; Keywords: wp +;; Keywords: text ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -58,7 +58,7 @@ (defvar glep-mode-preamble-limit 2000 "Maximum length of GLEP preamble. -For efficiency only. Unlimited if nil.") +For efficiency only. Unlimited if nil.") (defun glep-mode-update-last-modified () "Update the Last-Modified date." @@ -182,9 +182,9 @@ Calls the external \"glep\" command." (interactive) (or buffer-file-name (error "No file for this buffer")) - (let* ((rst-file (file-relative-name buffer-file-name)) - (html-file (concat (file-name-sans-extension rst-file) ".html"))) - (compile (format "glep %s %s" rst-file html-file)))) + (let* ((src (file-relative-name buffer-file-name)) + (dst (concat (file-name-sans-extension src) ".html"))) + (compile (format "glep %s %s" src dst)))) ;;; Skeleton support. diff --git a/keyword-generation.sh b/keyword-generation.sh index 1c73b5a..b8ab6ac 100755 --- a/keyword-generation.sh +++ b/keyword-generation.sh @@ -10,7 +10,7 @@ REPO=gentoo # Obsolete eclasses -OBSOLETE="eapi7_ver eqawarn versionator" +OBSOLETE="" TMPFILE="$(mktemp ${TMPDIR:-/tmp}/keyword-generation.XXXXXX)" diff --git a/test/devbook-mode-tests.el b/test/devbook-mode-tests.el new file mode 100644 index 0000000..321e1e6 --- /dev/null +++ b/test/devbook-mode-tests.el @@ -0,0 +1,72 @@ +;;; devbook-mode-tests.el --- tests for devbook-mode.el -*-lexical-binding:t-*- + +;; Copyright 2024 Gentoo Authors + +;; Author: Ulrich Müller <ulm@gentoo.org> +;; Maintainer: <emacs@gentoo.org> + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 2 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'devbook-mode) + +(defmacro devbook-mode-test-run-silently (&rest body) + `(let ((inhibit-message t)) ,@body)) + +(defvar devbook-mode-test-input nil) + +(defun devbook-mode-test-input (&rest _args) + (concat (pop devbook-mode-test-input))) + +(ert-deftest devbook-mode-test-skeleton () + (with-temp-buffer + (cl-letf (((symbol-function 'read-from-minibuffer) + #'devbook-mode-test-input) + ((symbol-function 'read-string) + #'devbook-mode-test-input) + (buffer-file-name + "/home/larry/devmanual/quickstart/text.xml")) + (setq devbook-mode-test-input + '("Quickstart guide")) + (devbook-insert-skeleton)) + (let ((buf1 (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" + "<guide self=\"quickstart/\">\n" + "<chapter>\n" + "<title>Quickstart guide</title>\n")) + (buf2 (concat "\n" + "</chapter>\n" + "</guide>\n"))) + (should (equal (point) + (+ (point-min) (length buf1)))) + (should (string-equal (buffer-string) + (concat buf1 buf2)))))) + +(ert-deftest devbook-mode-test-keybindings () + (should (equal (lookup-key devbook-mode-map "\C-c\C-n") + 'devbook-insert-skeleton)) + (with-temp-buffer + (devbook-mode-test-run-silently + (devbook-mode)) + (should (equal (local-key-binding "\C-c\C-n") + 'devbook-insert-skeleton)))) + +(provide 'devbook-mode-tests) + +;; Local Variables: +;; coding: utf-8 +;; End: + +;;; devbook-mode-tests.el ends here diff --git a/test/ebuild-mode-tests.el b/test/ebuild-mode-tests.el index 1237aae..a295e8b 100644 --- a/test/ebuild-mode-tests.el +++ b/test/ebuild-mode-tests.el @@ -23,13 +23,37 @@ (require 'ert) (require 'ebuild-mode) +(eval-when-compile + (unless (fboundp 'cl-letf) + (defalias 'cl-letf #'letf) + (defalias 'cl-letf* #'letf*))) + (defmacro ebuild-mode-test-run-with-fixed-time (&rest body) - `(cl-letf* ((fixed-time (date-to-time "2024-08-10T00:00:00Z")) - (orig-fun (symbol-function 'format-time-string)) - ((symbol-function 'format-time-string) - (lambda (fmt-string &optional time &rest args) - (apply orig-fun fmt-string (or time fixed-time) args)))) - ,@body)) + (let ((encode-time (if (and (fboundp 'func-arity) + (>= 1 (car (func-arity 'encode-time)))) + ;; new calling convention since Emacs 27 + '(encode-time) '(apply #'encode-time))) + (zone (if (or (not (featurep 'xemacs)) + (function-allows-args #'format-time-string 3)) + (list 'zone)))) + `(cl-letf* ((fixed-time (,@encode-time '(0 0 0 10 8 2024 nil nil 0))) + (orig-fun (symbol-function 'format-time-string)) + ((symbol-function 'format-time-string) + (lambda (fmt-string &optional time ,@zone) + (funcall orig-fun fmt-string (or time fixed-time) ,@zone)))) + ,@body))) + +(defmacro ebuild-mode-test-run-silently (&rest body) + (if (boundp 'inhibit-message) + `(let ((inhibit-message t)) ,@body) + `(cl-letf (((symbol-function 'append-message) #'ignore) + ((symbol-function 'clear-message) #'ignore)) + ,@body))) + +(defvar ebuild-mode-test-input nil) + +(defun ebuild-mode-test-input (&rest _args) + (concat (pop ebuild-mode-test-input))) (ert-deftest ebuild-mode-test-arch-lessp () (should (ebuild-mode-arch-lessp "amd64" "x86")) @@ -37,21 +61,54 @@ (should (ebuild-mode-arch-lessp "x86-linux" "ppc-macos"))) (ert-deftest ebuild-mode-test-time-string () - (should (string-equal - (ebuild-mode-time-string "%Y-%m-%d %H:%M:%S" '(14257 22633)) - "1999-08-11 11:03:05")) - (should (string-equal - (ebuild-mode-time-string "%Y-%m-%d %H:%M:%S" '(33451 44363)) - "2039-06-21 17:11:39"))) + (ebuild-mode-test-run-with-fixed-time + (should (string-equal + (ebuild-mode-time-string "%Y-%m-%d %H:%M:%S") + "2024-08-10 00:00:00")))) + +(ert-deftest ebuild-mode-test-collect-and-split () + (let* ((alist '(((a b) z) ((c d) z) ((e) z) ((f) z) ((g h) z) + ((i j) y x) ((k) y x) ((l)) ((m) z) ((n o) y x) ((p)) + ((q r s t u v) w))) + (alist1 (copy-tree alist))) + (should (equal (ebuild-mode-collect-and-split alist) + '(((a b c d e f g h m) z) ((i j k n o) y x) ((l p)) + ((q r s t u v) w)))) + (should (equal (ebuild-mode-collect-and-split alist 4) + '(((a b c d) z) ((e f g h) z) ((i j k) y x) ((l p)) + ((m) z) ((n o) y x) ((q r s t) w) ((u v) w)))) + ;; was it non-destructive? + (should (equal alist alist1)))) + +(ert-deftest ebuild-mode-test-font-lock-keywords () + (let ((case-fold-search nil) + (findkey (lambda (key) + (catch 'found + (dolist (c ebuild-mode-font-lock-keywords) + (if (string-match (car c) key) + (throw 'found (cdr c)))))))) + ;; Verify that all regexps are below the 32 KiB limit. + ;; Our regexps are ASCII only, so don't bother with string-bytes + ;; (GNU Emacs), string-char-byte-conversion-info (XEmacs 21.5), + ;; or other horrid incompatibilities. + (should (< (apply #'max (mapcar (lambda (c) (length (car c))) + ebuild-mode-font-lock-keywords)) + 32768)) + (should (equal (funcall findkey "doins") 'font-lock-builtin-face)) + (should (equal (funcall findkey "elisp-compile") 'font-lock-type-face)) + (should (equal (funcall findkey "# @ECLASS") '(1 font-lock-type-face t))) + (should-not (funcall findkey "@ECLASS")))) (ert-deftest ebuild-mode-test-font-lock () (with-temp-buffer - (let ((inhibit-message t)) - (ebuild-mode)) + (ebuild-mode-test-run-silently + (ebuild-mode)) (insert "src_install() {\n" "\temake install\n" "}\n") - (font-lock-ensure) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (font-lock-fontify-region (point-min) (point-max))) (goto-char (point-min)) (search-forward "src_install") (should (equal (get-text-property (match-beginning 0) 'face) @@ -62,17 +119,6 @@ (search-forward "install") (should-not (get-text-property (match-beginning 0) 'face)))) -(ert-deftest ebuild-mode-test-collect-and-split () - (let ((alist '(((a b) z) ((c d) z) ((e) z) ((f) z) ((g h) z) - ((i j) y) ((k) y) ((l m) x) ((n) z) ((o p) y) - ((q r s t u v) w)))) - (should (equal (ebuild-mode-collect-and-split alist) - '(((q r s t u v) w) ((l m) x) ((i j k o p) y) - ((a b c d e f g h n) z)))) - (should (equal (ebuild-mode-collect-and-split alist 4) - '(((q r) w) ((s t u v) w) ((o p) y) ((n) z) ((l m) x) - ((i j k) y) ((e f g h) z) ((a b c d) z)))))) - (ert-deftest ebuild-mode-test-update-copyright () (let ((ebuild-mode-update-copyright t)) (ebuild-mode-test-run-with-fixed-time @@ -84,6 +130,7 @@ "# Copyright 2023-2024 Gentoo Authors\n")) (erase-buffer) (insert "# Copyright 2020-2023 other author\n") + (ebuild-mode-update-copyright) (should (string-equal (buffer-string) "# Copyright 2020-2023 other author\n")))))) @@ -125,11 +172,11 @@ (should (string-equal (ebuild-mode-unescape-string "äöü" 'ansi-c) "äöü")) - (should (string-equal - (decode-coding-string - (ebuild-mode-unescape-string "\\360\\237\\221\\215" 'ansi-c) - 'utf-8-unix) - "👍"))) + (let ((s (ebuild-mode-unescape-string "\\360\\237\\221\\215" 'ansi-c))) + (if (or (not (featurep 'xemacs)) + (emacs-version>= 21 5)) + (setq s (decode-coding-string s 'utf-8-unix))) + (should (string-equal s "👍")))) (ert-deftest ebuild-mode-test-get-keywords () (with-temp-buffer @@ -175,6 +222,71 @@ (buffer-string) "KEYWORDS=\"~amd64 ~arm -m68k ~ppc64 ~x86\"\n")))) +(ert-deftest ebuild-mode-test-skeleton () + (with-temp-buffer + (cl-letf (((symbol-function 'read-from-minibuffer) + #'ebuild-mode-test-input) + ((symbol-function 'read-string) + #'ebuild-mode-test-input)) + (setq ebuild-mode-test-input + '("8" ; EAPI + "" ; inherit + "Skeleton test" ; DESCRIPTION + "https://www.gentoo.org/" ; HOMEPAGE + "" ; SRC_URI + "" ; S + "GPL-2+" "MIT" "" ; LICENSE + "~amd64" "" ; KEYWORDS + "" ; IUSE + "")) ; RESTRICT + (ebuild-mode-test-run-with-fixed-time + (if (featurep 'xemacs) + ;; prevent a segfault (seen with XEmacs 21.4.24 and 21.5.35) + (cl-letf (((symbol-function 'pos-visible-in-window-p) + (lambda (&rest _args) t))) + (ebuild-mode-insert-skeleton)) + (ebuild-mode-insert-skeleton))) + (should (string-equal + (buffer-string) + (concat "# Copyright 2024 Gentoo Authors\n" + "# Distributed under the terms of the " + "GNU General Public License v2\n\n" + "EAPI=8\n\n" + "DESCRIPTION=\"Skeleton test\"\n" + "HOMEPAGE=\"https://www.gentoo.org/\"\n" + "SRC_URI=\"\"\n\n" + "LICENSE=\"GPL-2+ MIT\"\n" + "SLOT=\"0\"\n" + "KEYWORDS=\"~amd64\"\n\n" + "RDEPEND=\"\"\n" + "DEPEND=\"${RDEPEND}\"\n" + "BDEPEND=\"\"\n")))))) + +(ert-deftest ebuild-mode-test-bug-url () + (skip-unless (fboundp 'bug-reference-prog-mode)) + (let* ((ebuild-mode-enable-bug-reference t) + found + (browse-url-browser-function + (lambda (url &rest _args) (setq found url)))) + (with-temp-buffer + (insert "# abc #876543 xyz\n" + "# bug 765432\n") + (ebuild-mode-test-run-silently + (ebuild-mode)) + (bug-reference-fontify (point-min) (point-max)) + (goto-char (point-min)) + (search-forward "#" nil nil 2) + (bug-reference-push-button (point)) + (should (equal found "https://bugs.gentoo.org/876543")) + (setq found nil) + (search-forward "bug") + (bug-reference-push-button (point)) + (should (equal found "https://bugs.gentoo.org/765432")) + (setq found nil) + (bug-reference-push-button (point-min)) + (bug-reference-push-button (point-max)) + (should-not found)))) + (ert-deftest ebuild-mode-test-insert-tag-line () (let ((ebuild-mode-full-name "Larry the Cow") (ebuild-mode-mail-address "larry@example.org")) @@ -192,6 +304,17 @@ (buffer-string) "# Larry the Cow <larry@example.org> (2024-08-10)\n")))))) +(ert-deftest ebuild-mode-test-keybindings () + (should (equal (lookup-key ebuild-mode-map "\C-c\C-e\C-k") + 'ebuild-mode-keyword)) + (should (equal (lookup-key ebuild-repo-mode-map "\C-c-") + 'ebuild-mode-insert-tag-line)) + (with-temp-buffer + (ebuild-mode-test-run-silently + (ebuild-mode)) + (should (equal (local-key-binding "\C-c\C-eu") + 'ebuild-run-command-unpack)))) + (provide 'ebuild-mode-tests) ;; Local Variables: diff --git a/test/gentoo-newsitem-mode-tests.el b/test/gentoo-newsitem-mode-tests.el new file mode 100644 index 0000000..1ee2858 --- /dev/null +++ b/test/gentoo-newsitem-mode-tests.el @@ -0,0 +1,93 @@ +;;; gentoo-newsitem-mode-tests.el -*-lexical-binding:t-*- + +;; Copyright 2024 Gentoo Authors + +;; Author: Ulrich Müller <ulm@gentoo.org> +;; Maintainer: <emacs@gentoo.org> + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 2 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'gentoo-newsitem-mode) + +(eval-when-compile + (unless (fboundp 'cl-letf) + (defalias 'cl-letf #'letf) + (defalias 'cl-letf* #'letf*))) + +(defvar gentoo-newsitem-test-input nil) + +(defun gentoo-newsitem-test-input (&rest _args) + (concat (pop gentoo-newsitem-test-input))) + +(ert-deftest gentoo-newsitem-test-font-lock () + (with-temp-buffer + (gentoo-newsitem-mode) + (insert "Author: Larry the Cow\n") + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (font-lock-fontify-region (point-min) (point-max))) + (goto-char (point-min)) + (search-forward "Author") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-keyword-face)) + (search-forward "Larry") + (should-not (get-text-property (match-beginning 0) 'face)))) + +(ert-deftest gentoo-newsitem-test-skeleton () + (with-temp-buffer + (cl-letf (((symbol-function 'read-from-minibuffer) + #'gentoo-newsitem-test-input) + ((symbol-function 'read-string) + #'gentoo-newsitem-test-input)) + (setq gentoo-newsitem-test-input + '("Skeleton test" ; Title + "Larry the Cow <larry@example.org>" "" ; Author + "" ; Translator + "2024-08-10" ; Posted + "" ; News-Item-Format + "" ; Display-If-Installed + "" ; Display-If-Keyword + "")) ; Display-If-Profile + (if (featurep 'xemacs) + ;; prevent a segfault (seen with XEmacs 21.4.24 and 21.5.35) + (cl-letf (((symbol-function 'pos-visible-in-window-p) + (lambda (&rest _args) t))) + (gentoo-newsitem-insert-skeleton)) + (gentoo-newsitem-insert-skeleton)) + (should (string-equal + (buffer-string) + (concat "Title: Skeleton test\n" + "Author: Larry the Cow <larry@example.org>\n" + "Posted: 2024-08-10\n" + "Revision: 1\n" + "News-Item-Format: 2.0\n\n")))))) + +(ert-deftest gentoo-newsitem-test-keybindings () + (should (equal (lookup-key gentoo-newsitem-mode-map "\C-c\C-n") + 'gentoo-newsitem-insert-skeleton)) + (with-temp-buffer + (gentoo-newsitem-mode) + (should (equal (local-key-binding "\C-c\C-n") + 'gentoo-newsitem-insert-skeleton)))) + +(provide 'gentoo-newsitem-mode-tests) + +;; Local Variables: +;; coding: utf-8 +;; End: + +;;; gentoo-newsitem-mode-tests.el ends here diff --git a/test/glep-mode-tests.el b/test/glep-mode-tests.el index 228ff50..0706759 100644 --- a/test/glep-mode-tests.el +++ b/test/glep-mode-tests.el @@ -24,12 +24,21 @@ (require 'glep-mode) (defmacro glep-mode-test-run-with-fixed-time (&rest body) - `(cl-letf* ((fixed-time (date-to-time "2024-08-10T00:00:00Z")) - (orig-fun (symbol-function 'format-time-string)) - ((symbol-function 'format-time-string) - (lambda (fmt-string &optional time &rest args) - (apply orig-fun fmt-string (or time fixed-time) args)))) - ,@body)) + (let ((encode-time (if (and (fboundp 'func-arity) + (>= 1 (car (func-arity 'encode-time)))) + ;; new calling convention since Emacs 27 + '(encode-time) '(apply #'encode-time)))) + `(cl-letf* ((fixed-time (,@encode-time '(0 0 0 10 8 2024 nil nil 0))) + (orig-fun (symbol-function 'format-time-string)) + ((symbol-function 'format-time-string) + (lambda (fmt-string &optional time zone) + (funcall orig-fun fmt-string (or time fixed-time) zone)))) + ,@body))) + +(defvar glep-mode-test-input nil) + +(defun glep-mode-test-input (&rest _args) + (concat (pop glep-mode-test-input))) (ert-deftest glep-mode-test-font-lock () (with-temp-buffer @@ -79,6 +88,42 @@ "---\n" "Last-Modified: 2023-02-22\n")))))) +(ert-deftest glep-mode-test-skeleton () + (with-temp-buffer + (cl-letf (((symbol-function 'read-from-minibuffer) + #'glep-mode-test-input) + ((symbol-function 'read-string) + #'glep-mode-test-input) + (buffer-file-name + "/home/larry/devmanual/quickstart/text.xml")) + (setq glep-mode-test-input + '("9999" ; GLEP + "Skeleton test" ; Title + "Larry the Cow" ; Author + "Informational" ; Type + "Draft" ; Status + "1" ; Version + "" ; Requires + "")) ; Replaces + (glep-mode-test-run-with-fixed-time + (glep-mode-insert-skeleton))) + (goto-char (point-min)) + (search-forward "---\n" nil nil 2) + (should (string-equal + (buffer-substring (point-min) (point)) + (concat "---\n" + "GLEP: 9999\n" + "Title: Skeleton test\n" + "Author: Larry the Cow\n" + "Type: Informational\n" + "Status: Draft\n" + "Version: 1\n" + "Created: 2024-08-10\n" + "Last-Modified: 2024-08-10\n" + "Post-History: \n" + "Content-Type: text/x-rst\n" + "---\n"))))) + (ert-deftest glep-mode-test-in-preamble-p () (with-temp-buffer (let ((preamble "---\nGLEP: 2\n---\n")) @@ -91,6 +136,14 @@ (forward-line 3) (should-not (glep-mode-in-preamble-p (point))))) +(ert-deftest glep-mode-test-keybindings () + (should (equal (lookup-key glep-mode-map "\C-c\C-n") + 'glep-mode-insert-skeleton)) + (with-temp-buffer + (glep-mode) + (should (equal (local-key-binding "\C-c\C-n") + 'glep-mode-insert-skeleton)))) + (provide 'glep-mode-tests) ;; Local Variables: diff --git a/test/xemacs-test-wrapper.el b/test/xemacs-test-wrapper.el new file mode 100644 index 0000000..699e473 --- /dev/null +++ b/test/xemacs-test-wrapper.el @@ -0,0 +1,52 @@ +;; Copyright 2024 Gentoo Authors +;; Distributed under the terms of the GNU General Public License v2 or later + +;; Quick and dirty hack to make the tests work with XEmacs, where ERT +;; is not available. It defines some macros (just the few that we need; +;; this is far from being complete) in terms of the XEmacs test suite +;; harness. + +;; Run the tests: +;; xemacs -batch -q -no-site-file -eval "(add-to-list 'load-path nil)" \ +;; -l test/xemacs-test-wrapper -f batch-test-emacs test/mytest.el + +(require 'test-harness) +(provide 'ert) ; pretend that ERT is present + +(define-error 'test-skipped "Test skipped") + +(defmacro ert-deftest (name _args &rest body) + `(condition-case nil + (progn ,@body) + (test-skipped (message "SKIP: %s" ',name)))) + +(defun skip-unless (cond) + (unless cond (signal 'test-skipped nil))) + +(defmacro should (assertion) + (let ((args (ignore-errors + (destructuring-bind (s1 (s2 form) (s3 (err msg))) + assertion + (list (list s1 s2 s3) err msg form))))) + ;; handle (should (equal (should-error ...) '(error ...))) + (if (equal (car args) '(equal should-error quote)) + `(Check-Error-Message ,@(cdr args)) + `(Assert ,assertion)))) + +(defmacro should-not (assertion) + `(Assert (not ,assertion))) + +(defmacro should-error (form) + `(Check-Error 'error ,form)) + +;; return a useful exit status +(defadvice kill-emacs (before xemacs-test-wrapper-kill-emacs activate) + (let ((ret (ad-get-arg 0))) + (cond ((and (integerp ret) (>= ret 2))) + ((/= unexpected-test-suite-failures 0) + (setq ret 2)) + (t (dolist (result test-harness-file-results-alist) + ;; result is a list: (file passes total) + (if (/= (nth 1 result) (nth 2 result)) + (setq ret 1))))) + (ad-set-arg 0 ret))) |