commit 58eeddf56bfd0492930395d601cc3f63bd9223c9 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Fri Jun 5 00:04:53 2015 -0700 Omit U+0332 COMBINING LOW LINE in previous change It turns out that it does not work on Ubuntu 15.04. diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 8a2191e..b68ba8a 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -57,8 +57,8 @@ (defconst calendar-bahai-month-name-array ["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál" - "Asmá’" "‘Izzat" "Mas̲h̲íyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il" - "S̲h̲araf" "Sulṭán" "Mulk" "‘Alá’"] + "Asmá’" "‘Izzat" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il" + "Sharaf" "Sulṭán" "Mulk" "‘Alá’"] "Array of the month names in the Bahá'í calendar.") (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) commit 8453c732954a5386bb9f91494f4a35e174d42225 Author: Paul Eggert Date: Thu Jun 4 23:45:40 2015 -0700 Fix transliteration of Bahá'í months * lisp/calendar/cal-bahai.el (calendar-bahai-month-name-array): Improve quality of Latin transliteration of Bahá'í month names. diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 180e5f9..8a2191e 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -42,7 +42,7 @@ ;; Váhids. A cycle of 19 Váhids (361 years) is called a Kullu-Shay, ;; which means "all things". -;; The calendar was named the "Badí` calendar" by its author, the Báb. +;; The calendar was named the "Badí‘ calendar" by its author, the Báb. ;; It uses a week of seven days, corresponding to the Gregorian week, ;; each of which has its own name, again patterned after the ;; attributes of God. @@ -56,9 +56,9 @@ (require 'calendar) (defconst calendar-bahai-month-name-array - ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál" - "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il" - "Sharaf" "Sultán" "Mulk" "`Alá"] + ["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál" + "Asmá’" "‘Izzat" "Mas̲h̲íyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il" + "S̲h̲araf" "Sulṭán" "Mulk" "‘Alá’"] "Array of the month names in the Bahá'í calendar.") (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) commit 1ba0149572ff9841c4838a25358ef08a516976db Author: Paul Eggert Date: Thu Jun 4 23:44:38 2015 -0700 Fix curved quotes in a few places * lisp/calc/calc-misc.el (calc-help): Fix quoting. The strings in question are not doc strings, so this partially undoes the recent change that assumed they were doc strings. * lisp/cedet/srecode/srt-mode.el (srecode-macro-help): * lisp/info.el (Info-finder-find-node): Use curved quotes. * lisp/emacs-lisp/derived.el (derived-mode-make-docstring): Also allow curved quotes in doc strings. diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 60c6fb9..5d5f4ce 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -217,7 +217,7 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). (defun calc-help () (interactive) (let ((msgs - '("Press `h' for complete help; press `?' repeatedly for a summary" + '("Press ‘h’ for complete help; press ‘?’ repeatedly for a summary" "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit" "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option" "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB" @@ -225,7 +225,7 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args" "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)" "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)" - "Other keys: ' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)" + "Other keys: ' (alg-entry), = (eval), ` (edit); M-RET (last-args)" "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)" "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)" "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)" diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 79672ec..fbc5635 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -258,9 +258,9 @@ we can tell font lock about them.") (when (class-abstract-p C) (throw 'skip nil)) - (princ "`") + (princ "‘") (princ name) - (princ "'") + (princ "’") (when (slot-exists-p C 'key) (when key (princ " - Character Key: ") diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 52da4c9..75bd325 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -331,7 +331,8 @@ which more-or-less shadow%s %s's corresponding table%s." "\n\nThis mode " (concat "\n\nIn addition to any hooks its parent mode " - (if (string-match (regexp-quote (format "`%s'" parent)) + (if (string-match (regexp-quote (format "[`‘]%s['’]" + parent)) docstring) nil (format "`%s' " parent)) "might have run,\nthis mode ")) diff --git a/lisp/info.el b/lisp/info.el index 59ce465..9602337 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3707,7 +3707,7 @@ Build a menu of the possible matches." (insert "Finder Packages\n") (insert "***************\n\n") (insert - "The following packages match the keyword `" nodename "':\n\n") + "The following packages match the keyword ‘" nodename "’:\n\n") (insert "* Menu:\n\n") (let ((keywords (mapcar #'intern (if (string-match-p "," nodename) @@ -3734,7 +3734,7 @@ Build a menu of the possible matches." (insert "Package Description\n") (insert "*******************\n\n") (insert - "Description of the package `" nodename "':\n\n") + "Description of the package ‘" nodename "’:\n\n") ;; This assumes that a file named package.el exists, ;; which is not always true. E.g. for the nxml package, ;; there is no "nxml.el" (it's nxml-mode.el). commit 8fb6253c0073aaee5c76762da4356b3c5c56c273 Author: Glenn Morris Date: Thu Jun 4 21:19:22 2015 -0400 * lisp/Makefile.in (AM_V_at): Add missing definition. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ba3139d..9818d98 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -41,6 +41,11 @@ am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) am__v_GEN_0 = @echo " GEN " $@; am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = + # You can specify a different executable on the make command line, # e.g. "make EMACS=../src/emacs ...". commit 76f896dd1bbb87b487ba6d0b0913f6969e9d8ff8 Author: Glenn Morris Date: Thu Jun 4 21:16:23 2015 -0400 * lisp/Makefile.in: Quieten output a bit. ($(lisp)/cus-load.el, $(lisp)/finder-inf.el): Don't echo directories, since the commands we invoke print them. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 23b0e3f..ba3139d 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -150,7 +150,6 @@ PHONY_EXTRAS = custom-deps: $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/cus-load.el $(lisp)/cus-load.el $(lisp)/cus-load.el: - @echo Directories: ${SUBDIRS_ALMOST} $(AM_V_GEN)$(emacs) -l cus-dep \ --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \ -f custom-make-dependencies ${SUBDIRS_ALMOST} @@ -159,7 +158,6 @@ finder-data: $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/finder-inf.el \ $(lisp)/finder-inf.el $(lisp)/finder-inf.el: - @echo Directories: ${SUBDIRS_FINDER} $(AM_V_GEN)$(emacs) -l finder \ --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \ -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER} commit 0382a9346547e886445d4fecd920710c61d52e0c Author: Glenn Morris Date: Thu Jun 4 21:02:26 2015 -0400 * lisp/Makefile.in: Replace shell fragments in variables with $(shell). (SUBDIRS_REL, SUBDIRS_ABS, SUBDIRS_ALMOST, SUBDIRS_FINDER) (SUBDIRS_SUBDIRS): New variables. (setwins, setwins_almost, setwins_finder, setwins_for_subdirs): Remove. ($(lisp)/cus-load.el, $(lisp)/finder-inf.el, $(lisp)/loaddefs.el) (update-subdirs, compile-main, compile-clean): Replace "setwins" usage with new "SUBDIRS" variables. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index d8045bb..23b0e3f 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -115,36 +115,16 @@ unexport EMACSDATA EMACSDOC EMACSPATH # Prevent any setting of EMACSLOADPATH in user environment causing problems. emacs = EMACSLOADPATH= '$(EMACS)' $(EMACSOPT) -# Common command to find subdirectories -setwins=for file in `find . -type d -print`; do \ - case $$file in */.* ) ;; \ - *) wins="$$wins$${wins:+ }$$file" ;; \ - esac; \ - done - -# Find all subdirectories except `obsolete' and `term'. -setwins_almost=for file in `find ${srcdir} -type d -print`; do \ - case $$file in ${srcdir}*/obsolete | ${srcdir}*/term ) ;; \ - *) wins="$$wins$${wins:+ }$$file" ;; \ - esac; \ - done - -# Find all subdirectories except `obsolete', `term', and `leim' (and subdirs). -# We don't want the leim files listed as packages, especially -# since many share basenames with files in language/. -setwins_finder=for file in `find ${srcdir} -type d -print`; do \ - case $$file in ${srcdir}*/obsolete | ${srcdir}*/term | ${srcdir}*/leim* ) ;; \ - *) wins="$$wins$${wins:+ }$$file" ;; \ - esac; \ - done - -# Find all subdirectories in which we might want to create subdirs.el. -setwins_for_subdirs=for file in `find ${srcdir} -type d -print`; do \ - case $$file in \ - ${srcdir}*/cedet* | ${srcdir}*/leim* ) ;; \ - *) wins="$$wins$${wins:+ }$$file" ;; \ - esac; \ - done +SUBDIRS_REL = $(sort $(shell cd ${srcdir} && find . -type d -print)) +SUBDIRS_ABS = $(sort $(shell find ${srcdir} -type d -print)) +## All subdirectories except 'obsolete' and 'term'. +SUBDIRS_ALMOST = $(filter-out ${srcdir}/obsolete ${srcdir}/term,${SUBDIRS_ABS}) +## All subdirectories except 'obsolete', 'term', and 'leim' (and subdirs). +## We don't want the leim files listed as packages, especially +## since many share basenames with files in language/. +SUBDIRS_FINDER = $(filter-out ${srcdir}/leim%,${SUBDIRS_ALMOST}) +## All subdirectories in which we might want to create subdirs.el. +SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS_ABS}) # cus-load and finder-inf are not explicitly requested by anything, so # we add them here to make sure they get built. @@ -170,21 +150,19 @@ PHONY_EXTRAS = custom-deps: $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/cus-load.el $(lisp)/cus-load.el $(lisp)/cus-load.el: - $(AM_V_GEN)$(setwins_almost); \ - echo Directories: $$wins; \ - $(emacs) -l cus-dep \ + @echo Directories: ${SUBDIRS_ALMOST} + $(AM_V_GEN)$(emacs) -l cus-dep \ --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \ - -f custom-make-dependencies $$wins + -f custom-make-dependencies ${SUBDIRS_ALMOST} finder-data: $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/finder-inf.el \ $(lisp)/finder-inf.el $(lisp)/finder-inf.el: - $(AM_V_GEN)$(setwins_finder); \ - echo Directories: $$wins; \ - $(emacs) -l finder \ + @echo Directories: ${SUBDIRS_FINDER} + $(AM_V_GEN)$(emacs) -l finder \ --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \ - -f finder-compile-keywords-make-dist $$wins + -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER} # Use expand-file-name rather than $abs_scrdir so that Emacs does not # get confused when it compares file-names for equality. @@ -194,21 +172,19 @@ $(lisp)/finder-inf.el: # and make this depend on leim. autoloads .PHONY: $(lisp)/loaddefs.el $(lisp)/loaddefs.el: $(LOADDEFS) - $(AM_V_GEN)$(setwins_almost); \ - echo Directories: $$wins; \ - $(emacs) -l autoload \ + @echo Directories: ${SUBDIRS_ALMOST} + $(AM_V_GEN)$(emacs) -l autoload \ --eval '(setq autoload-ensure-writable t)' \ --eval '(setq autoload-builtin-package-versions t)' \ --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ - -f batch-update-autoloads $$wins + -f batch-update-autoloads ${SUBDIRS_ALMOST} # This is required by the bootstrap-emacs target in ../src/Makefile, so # we know that if we have an emacs executable, we also have a subdirs.el. $(lisp)/subdirs.el: $(AM_V_GEN)$(MAKE) update-subdirs update-subdirs: - $(AM_V_at)$(setwins_for_subdirs); \ - for file in $$wins; do \ + $(AM_V_at)for file in ${SUBDIRS_SUBDIRS}; do \ $(srcdir)/../build-aux/update-subdirs $$file; \ done; @@ -307,8 +283,8 @@ compile-targets: $(TARGETS) # Compile all the Elisp files that need it. Beware: it approximates # `no-byte-compile', so watch out for false-positives! compile-main: leim semantic compile-clean - @(cd $(lisp) && $(setwins); \ - els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ + @(cd $(lisp) && \ + els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ for el in $$els; do \ test -f $$el || continue; \ test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \ @@ -321,8 +297,8 @@ compile-main: leim semantic compile-clean .PHONY: compile-clean # Erase left-over .elc files that do not have a corresponding .el file. compile-clean: - @cd $(lisp) && $(setwins); \ - elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \ + @cd $(lisp) && \ + elcs=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \ for el in `echo $$elcs | sed -e 's/\.elc/\.el/g'`; do \ if test -f "$$el" || test ! -f "$${el}c"; then :; else \ echo rm "$${el}c"; \ commit 09cefee10c63731e5a7f4af3db9ac0359fe5b4b4 Author: Glenn Morris Date: Thu Jun 4 20:47:05 2015 -0400 * lisp/vc/compare-w.el (compare-windows-get-window-function): Fix :version tag. diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index 5b92369..cec1644 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -150,7 +150,8 @@ out all highlighting later with the command `compare-windows-dehighlight'." (defvar compare-windows-overlays2 nil) (defvar compare-windows-sync-point nil) -(defcustom compare-windows-get-window-function 'compare-windows-get-recent-window +(defcustom compare-windows-get-window-function + 'compare-windows-get-recent-window "Function that provides the window to compare with." :type '(choice (function-item :tag "Most recently used window" @@ -159,7 +160,7 @@ out all highlighting later with the command `compare-windows-dehighlight'." compare-windows-get-next-window) (function :tag "Your function")) :group 'compare-windows - :version "25.0") + :version "25.1") (defun compare-windows-get-recent-window () "Return the most recently used window. commit 7c9a2ef84579e88447e8cdf46b6f38d83d0a8cc0 Author: YAMAMOTO Mitsuharu Date: Fri Jun 5 09:44:40 2015 +0900 * src/ftfont.c (ftfont_open2): Round divisions by upEM. diff --git a/src/ftfont.c b/src/ftfont.c index afeaeca..b37b404 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -1179,7 +1179,7 @@ ftfont_open2 (struct frame *f, bool scalable; int spacing; int i; - int upEM; + double upEM; val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); if (! CONSP (val)) @@ -1235,9 +1235,9 @@ ftfont_open2 (struct frame *f, && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0); if (scalable) { - font->ascent = ft_face->ascender * size / upEM; - font->descent = - ft_face->descender * size / upEM; - font->height = ft_face->height * size / upEM; + font->ascent = ft_face->ascender * size / upEM + 0.5; + font->descent = - ft_face->descender * size / upEM + 0.5; + font->height = ft_face->height * size / upEM + 0.5; } else { @@ -1255,7 +1255,7 @@ ftfont_open2 (struct frame *f, #endif /* FC_DUAL */ ) font->min_width = font->average_width = font->space_width - = (scalable ? ft_face->max_advance_width * size / upEM + = (scalable ? ft_face->max_advance_width * size / upEM + 0.5 : ft_face->size->metrics.max_advance >> 6); else { @@ -1285,8 +1285,10 @@ ftfont_open2 (struct frame *f, font->vertical_centering = 0; if (scalable) { - font->underline_position = -ft_face->underline_position * size / upEM; - font->underline_thickness = ft_face->underline_thickness * size / upEM; + font->underline_position = (-ft_face->underline_position * size / upEM + + 0.5); + font->underline_thickness = (ft_face->underline_thickness * size / upEM + + 0.5); } else { commit dcf18b5c84fc9704bb2d1cfd01519710f105d126 Author: YAMAMOTO Mitsuharu Date: Fri Jun 5 09:41:40 2015 +0900 Undo removal of x_clear_area call on expose for GTK3 or cairo. * src/xterm.c (handle_one_xevent) [HAVE_GTK3 || USE_CAIRO]: Clear exposed area. (Bug#20677) diff --git a/src/xterm.c b/src/xterm.c index 25c0d87..691ede5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7668,7 +7668,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } else { -#if defined (USE_GTK) && ! defined (HAVE_GTK3) && ! defined (USE_CAIRO) +#ifdef USE_GTK /* This seems to be needed for GTK 2.6 and later, see http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */ x_clear_area (f, commit ddaef07eca8b66fd6b6ec90f3f307eca663c9af7 Author: Glenn Morris Date: Thu Jun 4 19:27:05 2015 -0400 * doc/lispref/hash.texi (Creating Hash): Remove obsolete makehash. diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 98da321..9d60cc3 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -149,14 +149,6 @@ of the nominal size. The default for @var{threshold} is 0.8. @end table @end defun -@defun makehash &optional test -This is equivalent to @code{make-hash-table}, but with a different style -argument list. The argument @var{test} specifies the method -of key lookup. - -This function is obsolete. Use @code{make-hash-table} instead. -@end defun - You can also create a new hash table using the printed representation for hash tables. The Lisp reader can read this printed representation, provided each element in the specified hash table has commit cc88cb8ac4b0e25a36c79b2c3e30ebc214e34bf5 Author: Glenn Morris Date: Thu Jun 4 19:26:32 2015 -0400 * lisp/Makefile.in (check-defun-dups): Also skip ldefs-boot. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 22d5ddc..d8045bb 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -476,10 +476,11 @@ maintainer-clean: distclean bootstrap-clean check-declare: $(emacs) -l check-declare --eval '(check-declare-directory "$(lisp)")' +## This finds a lot of duplicates between foo.el and obsolete/foo.el. check-defun-dups: sed -n -e '/^(defun /s/\(.\)(.*/\1/p' \ - $$(find . -name '*.el' -print | grep -v 'loaddefs\.el') \ - | sort | uniq -d + $$(find . -name '*.el' -print | \ + grep -Ev '(loaddefs|ldefs-boot)\.el') | sort | uniq -d # Dependencies commit 058ecce357adf8a8263aa8a75748488290898312 Author: Glenn Morris Date: Thu Jun 4 19:25:48 2015 -0400 * lisp/leim/quail/lrt.el (quail-lrt-update-translation): Rename from quail-lao-update-translation, since lao.el defines that. diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el index 081535a..342b52d 100644 --- a/lisp/leim/quail/lrt.el +++ b/lisp/leim/quail/lrt.el @@ -34,7 +34,7 @@ ;; key sequence: ;; consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ] -(defun quail-lao-update-translation (control-flag) +(defun quail-lrt-update-translation (control-flag) (if (integerp control-flag) ;; Non-composable character typed. (setq quail-current-str @@ -59,7 +59,7 @@ `\\' (backslash) + `$' => ຯ LAO ELLIPSIS " nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout - nil nil nil 'quail-lao-update-translation nil t) + nil nil nil 'quail-lrt-update-translation nil t) ;; LRT (Lao Roman Transcription) input method accepts the following ;; key sequence: commit f6fc446d93d0c3d19aad779fd093d8408a6e3c31 Author: Dmitry Gutov Date: Fri Jun 5 01:34:40 2015 +0300 Handle new-style advice in find-funct * lisp/emacs-lisp/find-func.el (find-function-advised-original): Handle new-style advice. Return the symbol's function definition. (Bug#20718) (find-function-library): Update accordingly. diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 7ea13d4..54f8340 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -189,12 +189,15 @@ defined in C.") (declare-function ad-get-advice-info "advice" (function)) (defun find-function-advised-original (func) - "Return the original function symbol of an advised function FUNC. -If FUNC is not the symbol of an advised function, just returns FUNC." + "Return the original function definition of an advised function FUNC. +If FUNC is not a symbol, return it. Else, if it's not advised, +return the symbol's function definition." (or (and (symbolp func) - (featurep 'advice) - (let ((ofunc (cdr (assq 'origname (ad-get-advice-info func))))) - (and (fboundp ofunc) ofunc))) + (featurep 'nadvice) + (let ((ofunc (advice--symbol-function func))) + (if (advice--p ofunc) + (advice--cd*r ofunc) + ofunc))) func)) (defun find-function-C-source (fun-or-var file type) @@ -331,7 +334,7 @@ signal an error. If VERBOSE is non-nil, and FUNCTION is an alias, display a message about the whole chain of aliases." (let ((def (if (symbolp function) - (symbol-function (find-function-advised-original function)))) + (find-function-advised-original function))) aliases) ;; FIXME for completeness, it might be nice to print something like: ;; foo (which is advised), which is an alias for bar (which is advised). @@ -344,8 +347,8 @@ message about the whole chain of aliases." (symbol-name def))) (format "`%s' is an alias for `%s'" function (symbol-name def))))) - (setq function (symbol-function (find-function-advised-original function)) - def (symbol-function (find-function-advised-original function)))) + (setq function (find-function-advised-original function) + def (find-function-advised-original function))) (if aliases (message "%s" aliases)) (cons function commit d4aca72ead4c1e53819e6e3249e26400a9879a0e Merge: 015c89a cfb3580 Author: Nicolas Petton Date: Thu Jun 4 22:30:29 2015 +0200 Merge branch 'map' commit cfb35800a8765b3458751bd6992a348f97843894 Author: Nicolas Petton Date: Thu Jun 4 22:26:22 2015 +0200 * lisp/emacs-lisp/map.el: Better docstring for the map pcase macro. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index dea2abc..46c7958 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -49,7 +49,8 @@ Matches if the object is a map (list, hash-table or array), and binds values from ARGS to the corresponding element of the map. -ARGS can be an alist of key/binding pairs of a list of keys." +ARGS can be a list elements of the form (KEY . PAT) or elements +of the form SYMBOL, which stands for (SYMBOL . SYMBOL)." `(and (pred map-p) ,@(map--make-pcase-bindings args))) commit 015c89a912f2486ec9ea24968705a84fe7d6fd06 Author: Nicolas Petton Date: Thu Jun 4 18:31:49 2015 +0200 ; * etc/NEWS: Add string-greaterp diff --git a/etc/NEWS b/etc/NEWS index d663795..ecf6022 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -870,7 +870,7 @@ evaluated (and should return a string) when the closure is built. ** define-inline provides a new way to define inlinable functions. -** New function macroexpand-1 to perform a single step of macroexpansion. +** New function `macroexpand-1' to perform a single step of macroexpansion. ** Some "x-*" were obsoleted: *** x-select-text is renamed gui-select-text. @@ -880,6 +880,9 @@ evaluated (and should return a string) when the closure is built. *** x-get-selection-value is renamed to gui-get-primary-selection. *** x-set-selection is renamed to gui-set-selection +** New function `string-greaterp', which return the opposite result of +`string-lessp'. + ** New function `alist-get', which is also a valid place (aka lvalue). ** New function `funcall-interactively', which works like `funcall' commit 41a929c5ae1110e39f94c018dc2b3e224e884f18 Author: Nicolas Petton Date: Thu Jun 4 18:20:18 2015 +0200 Add new function string-greaterp * lisp/subr.el (string-greaterp): New function. Also aliased to `string>'. * test/automated/subr-tests.el (string-comparison-test): Add unit tests for `string>'and `string<'. * src/fns.c (string-lessp): Better docstring. diff --git a/lisp/subr.el b/lisp/subr.el index b9a847d..df17310 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1384,6 +1384,7 @@ is converted into a string by expressing it in decimal." (defalias 'send-region 'process-send-region) (defalias 'string= 'string-equal) (defalias 'string< 'string-lessp) +(defalias 'string> 'string-greaterp) (defalias 'move-marker 'set-marker) (defalias 'rplaca 'setcar) (defalias 'rplacd 'setcdr) @@ -3834,6 +3835,13 @@ consisting of STR followed by an invisible left-to-right mark (if (string-match "\\cR" str) (concat str (propertize (string ?\x200e) 'invisible t)) str)) + +(defun string-greaterp (string1 string2) + "Return non-nil if STRING1 is greater than STRING2 in lexicographic order. +Case is significant. +Symbols are also allowed; their print names are used instead." + (string-lessp string2 string1)) + ;;;; Specifying things to do later. diff --git a/src/fns.c b/src/fns.c index 235a4f6..6bbb57f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -303,26 +303,26 @@ If string STR1 is greater, the value is a positive number N; } DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, - doc: /* Return t if first arg string is less than second in lexicographic order. + doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. Case is significant. Symbols are also allowed; their print names are used instead. */) - (register Lisp_Object s1, Lisp_Object s2) + (register Lisp_Object string1, Lisp_Object string2) { register ptrdiff_t end; register ptrdiff_t i1, i1_byte, i2, i2_byte; - if (SYMBOLP (s1)) - s1 = SYMBOL_NAME (s1); - if (SYMBOLP (s2)) - s2 = SYMBOL_NAME (s2); - CHECK_STRING (s1); - CHECK_STRING (s2); + if (SYMBOLP (string1)) + string1 = SYMBOL_NAME (string1); + if (SYMBOLP (string2)) + string2 = SYMBOL_NAME (string2); + CHECK_STRING (string1); + CHECK_STRING (string2); i1 = i1_byte = i2 = i2_byte = 0; - end = SCHARS (s1); - if (end > SCHARS (s2)) - end = SCHARS (s2); + end = SCHARS (string1); + if (end > SCHARS (string2)) + end = SCHARS (string2); while (i1 < end) { @@ -330,13 +330,13 @@ Symbols are also allowed; their print names are used instead. */) characters, not just the bytes. */ int c1, c2; - FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte); - FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte); + FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte); + FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte); if (c1 != c2) return c1 < c2 ? Qt : Qnil; } - return i1 < SCHARS (s2) ? Qt : Qnil; + return i1 < SCHARS (string2) ? Qt : Qnil; } DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0, diff --git a/test/automated/subr-tests.el b/test/automated/subr-tests.el index d29efc6..28a423f 100644 --- a/test/automated/subr-tests.el +++ b/test/automated/subr-tests.el @@ -2,7 +2,8 @@ ;; Copyright (C) 2015 Free Software Foundation, Inc. -;; Author: Oleh Krehel +;; Author: Oleh Krehel , +;; Nicolas Petton ;; Keywords: ;; This file is part of GNU Emacs. @@ -60,5 +61,26 @@ (quote (0 font-lock-keyword-face)))))))) +(ert-deftest string-comparison-test () + (should (string-lessp "abc" "acb")) + (should (string-lessp "aBc" "abc")) + (should (string-lessp "abc" "abcd")) + (should (string-lessp "abc" "abcd")) + (should-not (string-lessp "abc" "abc")) + (should-not (string-lessp "" "")) + + (should (string-greaterp "acb" "abc")) + (should (string-greaterp "abc" "aBc")) + (should (string-greaterp "abcd" "abc")) + (should (string-greaterp "abcd" "abc")) + (should-not (string-greaterp "abc" "abc")) + (should-not (string-greaterp "" "")) + + ;; Symbols are also accepted + (should (string-lessp 'abc 'acb)) + (should (string-lessp "abc" 'acb)) + (should (string-greaterp 'acb 'abc)) + (should (string-greaterp "acb" 'abc))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit 285260fce84c945acb588a7c70d3df5d8271f586 Author: Eli Zaretskii Date: Thu Jun 4 18:28:29 2015 +0300 Fix timezone-related functions on MS-Windows * src/editfns.c (set_time_zone_rule) [WINDOWSNT]: Always call 'xputenv', even if no reallocation of tzvalbuf was necessary. This fixes a bug in timezone-related functions on MS-Windows. Reported by Fabrice Popineau . diff --git a/src/editfns.c b/src/editfns.c index c387dc7..bfa67e2 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2318,7 +2318,18 @@ set_time_zone_rule (const char *tzstring) tzval[tzeqlen] = 0; } - if (new_tzvalbuf) + if (new_tzvalbuf +#ifdef WINDOWSNT + /* MS-Windows implementation of 'putenv' copies the argument + string into a block it allocates, so modifying tzval string + does not change the environment. OTOH, the other threads run + by Emacs on MS-Windows never call 'xputenv' or 'putenv' or + 'unsetenv', so the original cause for the dicey in-place + modification technique doesn't exist there in the first + place. */ + || 1 +#endif + ) { /* Although this is not thread-safe, in practice this runs only on startup when there is only one thread. */ commit 988d72118687758af6c2b7c56c80056630d428ca (refs/remotes/origin/map) Author: Nicolas Petton Date: Tue Jun 2 22:13:38 2015 +0200 Add a pcase pattern for maps and `map-let' based on it * lisp/emacs-lisp/map.el (map-let): New macro. (map--make-pcase-bindings, map--make-pcase-patterns): New functions. * test/automated/map-tests.el: New test for `map-let'. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 8801b2a..dea2abc 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -44,6 +44,24 @@ (require 'seq) +(pcase-defmacro map (&rest args) + "pcase pattern matching map elements. +Matches if the object is a map (list, hash-table or array), and +binds values from ARGS to the corresponding element of the map. + +ARGS can be an alist of key/binding pairs of a list of keys." + `(and (pred map-p) + ,@(map--make-pcase-bindings args))) + +(defmacro map-let (args map &rest body) + "Bind the variables in ARGS to the elements of MAP then evaluate BODY. + +ARGS can be an alist of key/binding pairs or a list of keys. MAP +can be a list, hash-table or array." + (declare (indent 2) (debug t)) + `(pcase-let ((,(map--make-pcase-patterns args) ,map)) + ,@body)) + (defun map-elt (map key &optional default) "Perform a lookup in MAP of KEY and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. @@ -331,5 +349,22 @@ If KEY is not found, return DEFAULT which defaults to nil." map) ht)) +(defun map--make-pcase-bindings (args) + "Return a list of pcase bindings from ARGS to the elements of a map." + (seq-map (lambda (elt) + (if (consp elt) + `(app (pcase--flip map-elt ',(car elt)) ,(cdr elt)) + `(app (pcase--flip map-elt ',elt) ,elt))) + args)) + +(defun map--make-pcase-patterns (args) + "Return a list of `(map ...)' pcase patterns built from ARGS." + (cons 'map + (seq-map (lambda (elt) + (if (and (consp elt) (eq 'map (car elt))) + (map--make-pcase-patterns elt) + elt)) + args))) + (provide 'map) ;;; map.el ends here diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index e65af89..2f7d4eb 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -317,5 +317,17 @@ Evaluate BODY for each created map. (assert (map-empty-p (map-into nil 'hash-table))) (should-error (map-into [1 2 3] 'string)))) +(ert-deftest test-map-let () + (map-let (foo bar baz) '((foo . 1) (bar . 2)) + (assert (= foo 1)) + (assert (= bar 2)) + (assert (null baz))) + (map-let ((foo . a) + (bar . b) + (baz . c)) '((foo . 1) (bar . 2)) + (assert (= a 1)) + (assert (= b 2)) + (assert (null c)))) + (provide 'map-tests) ;;; map-tests.el ends here commit 6591d361390daa6c36045b82acb9ea548687879c Author: Nicolas Petton Date: Sat May 16 11:35:00 2015 +0200 * etc/NEWS: Add an entry about map.el diff --git a/etc/NEWS b/etc/NEWS index 5e312ed..2429a63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -407,6 +407,11 @@ The seq library adds sequence manipulation functions and macros that complement basic functions provided by subr.el. All functions are prefixed with `seq-' and work on lists, strings and vectors. +** map +*** New map library: +The map library provides map-manipulation functions that work on alists, +hash-table and arrays. All functions are prefixed with "map-". + ** Calendar and diary +++ commit 3fe404ca668c10763b1fcb1af3e56b7989d163a0 Author: Nicolas Petton Date: Sat May 16 11:30:12 2015 +0200 Improve the docstring of functions in map.el Since a map is not a data structure but a concept, adding information about the possible types of maps can be useful information. * lisp/emacs-lisp/map.el: Add documentation about the type of MAP to each public function. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 18d2963..8801b2a 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -48,7 +48,9 @@ "Perform a lookup in MAP of KEY and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. -If MAP is a list, `equal' is used to lookup KEY." +If MAP is a list, `equal' is used to lookup KEY. + +MAP can be a list, hash-table or array." (map--dispatch map :list (map--elt-list map key default) :hash-table (gethash key map default) @@ -57,7 +59,9 @@ If MAP is a list, `equal' is used to lookup KEY." (defmacro map-put (map key value) "In MAP, associate KEY with VALUE and return MAP. If KEY is already present in MAP, replace the associated value -with VALUE." +with VALUE. + +MAP can be a list, hash-table or array." (declare (debug t)) `(progn (map--dispatch (m ,map m) @@ -67,7 +71,9 @@ with VALUE." (defmacro map-delete (map key) "In MAP, delete the key KEY if present and return MAP. -If MAP is an array, store nil at the index KEY." +If MAP is an array, store nil at the index KEY. + +MAP can be a list, hash-table or array." (declare (debug t)) `(progn (map--dispatch (m ,map m) @@ -77,6 +83,7 @@ If MAP is an array, store nil at the index KEY." (defun map-nested-elt (map keys &optional default) "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil. + Map can be a nested map composed of alists, hash-tables and arrays." (or (seq-reduce (lambda (acc key) (when (map-p acc) @@ -86,23 +93,33 @@ Map can be a nested map composed of alists, hash-tables and arrays." default)) (defun map-keys (map) - "Return the list of keys in MAP." + "Return the list of keys in MAP. + +MAP can be a list, hash-table or array." (map-apply (lambda (key _) key) map)) (defun map-values (map) - "Return the list of values in MAP." + "Return the list of values in MAP. + +MAP can be a list, hash-table or array." (map-apply (lambda (_ value) value) map)) (defun map-pairs (map) - "Return the elements of MAP as key/value association lists." + "Return the elements of MAP as key/value association lists. + +MAP can be a list, hash-table or array." (map-apply #'cons map)) (defun map-length (map) - "Return the length of MAP." + "Return the length of MAP. + +MAP can be a list, hash-table or array." (length (map-keys map))) (defun map-copy (map) - "Return a copy of MAP." + "Return a copy of MAP. + +MAP can be a list, hash-table or array." (map--dispatch map :list (seq-copy map) :hash-table (copy-hash-table map) @@ -110,7 +127,9 @@ Map can be a nested map composed of alists, hash-tables and arrays." (defun map-apply (function map) "Apply FUNCTION to each element of MAP and return the result as a list. -FUNCTION is called with two arguments, the key and the value." +FUNCTION is called with two arguments, the key and the value. + +MAP can be a list, hash-table or array." (funcall (map--dispatch map :list #'map--apply-alist :hash-table #'map--apply-hash-table @@ -119,19 +138,25 @@ FUNCTION is called with two arguments, the key and the value." map)) (defun map-keys-apply (function map) - "Return the result of applying FUNCTION to each key of MAP." + "Return the result of applying FUNCTION to each key of MAP. + +MAP can be a list, hash-table or array." (map-apply (lambda (key _) (funcall function key)) map)) (defun map-values-apply (function map) - "Return the result of applying FUNCTION to each value of MAP." + "Return the result of applying FUNCTION to each value of MAP. + +MAP can be a list, hash-table or array." (map-apply (lambda (_ val) (funcall function val)) map)) (defun map-filter (pred map) - "Return an alist of the key/val pairs for which (PRED key val) is non-nil in MAP." + "Return an alist of the key/val pairs for which (PRED key val) is non-nil in MAP. + +MAP can be a list, hash-table or array." (delq nil (map-apply (lambda (key val) (if (funcall pred key val) (cons key val) @@ -139,7 +164,9 @@ FUNCTION is called with two arguments, the key and the value." map))) (defun map-remove (pred map) - "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP." + "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP. + +MAP can be a list, hash-table or array." (map-filter (lambda (key val) (not (funcall pred key val))) map)) @@ -150,7 +177,9 @@ FUNCTION is called with two arguments, the key and the value." (arrayp map))) (defun map-empty-p (map) - "Return non-nil is MAP is empty." + "Return non-nil is MAP is empty. + +MAP can be a list, hash-table or array." (map--dispatch map :list (null map) :array (seq-empty-p map) @@ -158,11 +187,15 @@ FUNCTION is called with two arguments, the key and the value." (defun map-contains-key-p (map key &optional testfn) "Return non-nil if MAP contain the key KEY, nil otherwise. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by TESTFN if non-nil or by `equal' if nil. + +MAP can be a list, hash-table or array." (seq-contains-p (map-keys map) key testfn)) (defun map-some-p (pred map) - "Return a key/value pair for which (PRED key val) is non-nil in MAP." + "Return a key/value pair for which (PRED key val) is non-nil in MAP. + +MAP can be a list, hash-table or array." (catch 'map--break (map-apply (lambda (key value) (when (funcall pred key value) @@ -171,7 +204,9 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." nil)) (defun map-every-p (pred map) - "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP." + "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP. + +MAP can be a list, hash-table or array." (catch 'map--break (map-apply (lambda (key value) (or (funcall pred key value) @@ -180,7 +215,9 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." t)) (defun map-merge (type &rest maps) - "Merge into a map of type TYPE all the key/value pairs in the maps MAPS." + "Merge into a map of type TYPE all the key/value pairs in the maps MAPS. + +MAP can be a list, hash-table or array." (let (result) (while maps (map-apply (lambda (key value) @@ -190,7 +227,9 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (defun map-into (map type) "Convert the map MAP into a map of type TYPE. -TYPE can be one of the following symbols: list or hash-table." + +TYPE can be one of the following symbols: list or hash-table. +MAP can be a list, hash-table or array." (pcase type (`list (map-pairs map)) (`hash-table (map--into-hash-table map)) commit a5237a049981dbad2ecc3b17d47257ce164a8e70 Author: Nicolas Petton Date: Wed Apr 29 19:01:56 2015 +0200 Faster implementation of map-empty-p * lisp/emacs-lisp/map.el (map-empty-p): Faster implementation using specific tests depending on the type of the map. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ff0dc12..18d2963 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -150,7 +150,11 @@ FUNCTION is called with two arguments, the key and the value." (arrayp map))) (defun map-empty-p (map) - (null (map-keys map))) + "Return non-nil is MAP is empty." + (map--dispatch map + :list (null map) + :array (seq-empty-p map) + :hash-table (zerop (hash-table-count map)))) (defun map-contains-key-p (map key &optional testfn) "Return non-nil if MAP contain the key KEY, nil otherwise. commit 12a3ea52c4d5e3a62af5f8eaaa2df7f2e4b66da2 Author: Nicolas Petton Date: Wed Apr 29 19:01:40 2015 +0200 * lisp/emacs-lisp/map.el: Better docstrings. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 4b53524..ff0dc12 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -76,7 +76,7 @@ If MAP is an array, store nil at the index KEY." :array (map--delete-array m ,key)))) (defun map-nested-elt (map keys &optional default) - "Travserse MAP using KEYS and return the looked up value or DEFAULT if nil. + "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil. Map can be a nested map composed of alists, hash-tables and arrays." (or (seq-reduce (lambda (acc key) (when (map-p acc) @@ -109,7 +109,7 @@ Map can be a nested map composed of alists, hash-tables and arrays." :array (seq-copy map))) (defun map-apply (function map) - "Return the result of applying FUNCTION to each element of MAP. + "Apply FUNCTION to each element of MAP and return the result as a list. FUNCTION is called with two arguments, the key and the value." (funcall (map--dispatch map :list #'map--apply-alist @@ -131,7 +131,7 @@ FUNCTION is called with two arguments, the key and the value." map)) (defun map-filter (pred map) - "Return an alist of the key/val pairs of which (PRED key val) is non-nil in MAP." + "Return an alist of the key/val pairs for which (PRED key val) is non-nil in MAP." (delq nil (map-apply (lambda (key val) (if (funcall pred key val) (cons key val) @@ -139,7 +139,7 @@ FUNCTION is called with two arguments, the key and the value." map))) (defun map-remove (pred map) - "Return an alist of the key/val pairs of which (PRED key val) is nil in MAP." + "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP." (map-filter (lambda (key val) (not (funcall pred key val))) map)) @@ -150,18 +150,15 @@ FUNCTION is called with two arguments, the key and the value." (arrayp map))) (defun map-empty-p (map) - "Return non-nil is MAP is empty. -MAP can be a list, hash-table or array." (null (map-keys map))) (defun map-contains-key-p (map key &optional testfn) "Return non-nil if MAP contain the key KEY, nil otherwise. -Equality is defined by TESTFN if non-nil or by `equal' if nil. -MAP can be a list, hash-table or array." +Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-contains-p (map-keys map) key testfn)) (defun map-some-p (pred map) - "Return any key/value pair for which (PRED key val) is non-nil is MAP." + "Return a key/value pair for which (PRED key val) is non-nil in MAP." (catch 'map--break (map-apply (lambda (key value) (when (funcall pred key value) commit c576ab54b50731fbcc263eeb118d45a89e39f87e Author: Artur Malabarba Date: Sat Apr 25 17:27:13 2015 +0100 * lisp/emacs-lisp/map.el (map-pairs): Dump redundant lambda diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 3efab40..4b53524 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -95,9 +95,7 @@ Map can be a nested map composed of alists, hash-tables and arrays." (defun map-pairs (map) "Return the elements of MAP as key/value association lists." - (map-apply (lambda (key value) - (cons key value)) - map)) + (map-apply #'cons map)) (defun map-length (map) "Return the length of MAP." commit 5e52b0a0767bff530956863afc62784a4b2e5777 Author: Nicolas Petton Date: Sat Apr 25 16:56:19 2015 +0200 * lisp/emacs-lisp/map.el (map--elt-list): Better docstring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index b64b2bf..3efab40 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -254,7 +254,7 @@ form. map))) (defun map--elt-list (map key &optional default) - "Return the element of the list MAP at the index KEY. + "Lookup, in the list MAP, the value associated with KEY and return it. If KEY is not found, return DEFAULT which defaults to nil." (let ((pair (assoc key map))) (if pair commit 40a8a12a26763addb0422105330deb278ce87012 Author: Nicolas Petton Date: Sat Apr 25 16:53:09 2015 +0200 * lisp/emacs-lisp/map.el (map--elt-list): Minor refactoring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ebf1fe9..b64b2bf 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -258,7 +258,7 @@ form. If KEY is not found, return DEFAULT which defaults to nil." (let ((pair (assoc key map))) (if pair - (cdr (assoc key map)) + (cdr pair) default))) (defun map--elt-array (map key &optional default) commit 62879799ea0272f2ed3067252f20afb910bce352 Author: Nicolas Petton Date: Sat Apr 25 12:07:12 2015 +0200 Fix a false negative in `map-elt' with alists and values being nil * lisp/emacs-lisp/map.el (map-elt): If map is an alist and key is found but its associated value is nil, do not return the default value. * test/automated/map-tests.el: Add a regression test. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 3984b08..ebf1fe9 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -50,7 +50,7 @@ If KEY is not found, return DEFAULT which defaults to nil. If MAP is a list, `equal' is used to lookup KEY." (map--dispatch map - :list (or (cdr (assoc key map)) default) + :list (map--elt-list map key default) :hash-table (gethash key map default) :array (map--elt-array map key default))) @@ -253,8 +253,17 @@ form. (setq index (1+ index)))) map))) +(defun map--elt-list (map key &optional default) + "Return the element of the list MAP at the index KEY. +If KEY is not found, return DEFAULT which defaults to nil." + (let ((pair (assoc key map))) + (if pair + (cdr (assoc key map)) + default))) + (defun map--elt-array (map key &optional default) - "Return the element of the arary MAP at the index KEY, or DEFAULT if nil." + "Return the element of the array MAP at the index KEY. +If KEY is not found, return DEFAULT which defaults to nil." (let ((len (seq-length map))) (or (and (>= key 0) (<= key len) diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 5201116..e65af89 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -66,6 +66,12 @@ Evaluate BODY for each created map. (with-maps-do map (assert (= 5 (map-elt map 7 5))))) +(ert-deftest test-map-elt-with-nil-value () + (assert (null (map-elt '((a . 1) + (b)) + 'b + '2)))) + (ert-deftest test-map-put () (with-maps-do map (map-put map 2 'hello) commit eea2e831381a7b33ecfcd1c4dfee725a917befd3 Author: Nicolas Petton Date: Fri Apr 24 19:33:18 2015 +0200 * lisp/emacs-lisp/map.el (map--dispatch): Improve the docstring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 087ab28..3984b08 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -206,7 +206,7 @@ ARGS should have the form [TYPE FORM]... The following keyword types are meaningful: `:list', `:hash-table' and `array'. -An error is thrown if MAP is neither a list, hash-table or array. +An error is thrown if MAP is neither a list, hash-table nor array. Return RESULT if non-nil or the result of evaluation of the form. commit d75151a671dcdc1cac8c6ab1a47520bae4872d70 Author: Nicolas Petton Date: Fri Apr 24 19:29:59 2015 +0200 Do not signal an error when trying to delete a key from an array * lisp/emacs-lisp/map.el (map-delete): When map is an array, check if the key is present to avoid signaling an error. * test/automated/map-tests.el: Add a test for deleting non-existing keys from maps. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 621c37f..087ab28 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -73,7 +73,7 @@ If MAP is an array, store nil at the index KEY." (map--dispatch (m ,map m) :list (setq ,map (map--delete-alist m ,key)) :hash-table (remhash ,key m) - :array (aset m ,key nil)))) + :array (map--delete-array m ,key)))) (defun map-nested-elt (map keys &optional default) "Travserse MAP using KEYS and return the looked up value or DEFAULT if nil. @@ -261,13 +261,20 @@ form. (seq-elt map key)) default))) - (defun map--delete-alist (map key) "Return MAP with KEY removed." (seq-remove (lambda (pair) (equal key (car pair))) map)) +(defun map--delete-array (map key) + "Set nil in the array MAP at the index KEY if present and return MAP." + (let ((len (seq-length map))) + (and (>= key 0) + (<= key len) + (aset m key nil))) + map) + (defun map--into-hash-table (map) "Convert MAP into a hash-table." (let ((ht (make-hash-table :size (map-length map) diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index f41cd70..5201116 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -96,7 +96,10 @@ Evaluate BODY for each created map. (ert-deftest test-map-delete () (with-maps-do map (map-delete map 1) - (assert (null (map-elt map 1))))) + (assert (null (map-elt map 1)))) + (with-maps-do map + (map-delete map -2) + (assert (null (map-elt map -2))))) (ert-deftest test-map-delete-return-value () (let ((ht (make-hash-table))) commit 79d9757c2334364a78a2e40b75d8d4e96161a911 Author: Nicolas Petton Date: Fri Apr 24 19:15:23 2015 +0200 * lisp/emacs-lisp/map.el: Better docstring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 2c95f35..621c37f 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -56,7 +56,8 @@ If MAP is a list, `equal' is used to lookup KEY." (defmacro map-put (map key value) "In MAP, associate KEY with VALUE and return MAP. -If KEY is already present in MAP, replace its value with VALUE." +If KEY is already present in MAP, replace the associated value +with VALUE." (declare (debug t)) `(progn (map--dispatch (m ,map m) commit f37e265ea992f5799f1bf30a03509444c976df1d Author: Nicolas Petton Date: Fri Apr 24 19:06:27 2015 +0200 Minor improvement in map-elt. * lisp/emacs-lisp/map.el (map-elt): Do not use `ignore-errors' when doing a lookup in arrays, but check the boundaries of the array instead. * test/automated/map-tests.el: Adds a test for `map-elt' with arrays and a negative integer as key. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 06fd7ad..2c95f35 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -48,11 +48,11 @@ "Perform a lookup in MAP of KEY and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. -If MAP is a list, `assoc' is used to lookup KEY." +If MAP is a list, `equal' is used to lookup KEY." (map--dispatch map :list (or (cdr (assoc key map)) default) :hash-table (gethash key map default) - :array (or (ignore-errors (elt map key)) default))) + :array (map--elt-array map key default))) (defmacro map-put (map key value) "In MAP, associate KEY with VALUE and return MAP. @@ -252,6 +252,15 @@ form. (setq index (1+ index)))) map))) +(defun map--elt-array (map key &optional default) + "Return the element of the arary MAP at the index KEY, or DEFAULT if nil." + (let ((len (seq-length map))) + (or (and (>= key 0) + (<= key len) + (seq-elt map key)) + default))) + + (defun map--delete-alist (map key) "Return MAP with KEY removed." (seq-remove (lambda (pair) diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 9a0d99e..f41cd70 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -59,6 +59,7 @@ Evaluate BODY for each created map. (assert (= 3 (map-elt map 0))) (assert (= 4 (map-elt map 1))) (assert (= 5 (map-elt map 2))) + (assert (null (map-elt map -1))) (assert (null (map-elt map 4))))) (ert-deftest test-map-elt-default () commit 89baf163324c6820ca17e91cda9dc8b162a59eab Author: Nicolas Petton Date: Tue Apr 21 20:53:28 2015 +0200 * test/automated/map-tests.el: Refactoring of test methods. diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index ea7b0af..9a0d99e 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -29,56 +29,56 @@ (require 'ert) (require 'map) -(defmacro with-maps-do (alist-name vec-name ht-name &rest body) - (declare (indent 3)) - `(let ((,alist-name '((a . 2) - (b . 3) - (c . 4))) - (,vec-name (make-vector 3 nil)) - (,ht-name (make-hash-table))) - (aset ,vec-name 0 'a) - (aset ,vec-name 1 'b) - (aset ,vec-name 2 'c) - (puthash 'a 2 ,ht-name) - (puthash 'b 3 ,ht-name) - (puthash 'c 4 ,ht-name) - (progn - ,@body))) +(defmacro with-maps-do (var &rest body) + "Successively bind VAR to an alist, vector and hash-table. +Each map is built from the following alist data: +'((0 . 3) (1 . 4) (2 . 5)). +Evaluate BODY for each created map. + +\(fn (var map) body)" + (declare (indent 1) (debug t)) + (let ((alist (make-symbol "alist")) + (vec (make-symbol "vec")) + (ht (make-symbol "ht"))) + `(let ((,alist '((0 . 3) + (1 . 4) + (2 . 5))) + (,vec (make-vector 3 nil)) + (,ht (make-hash-table))) + (aset ,vec 0 '3) + (aset ,vec 1 '4) + (aset ,vec 2 '5) + (puthash '0 3 ,ht) + (puthash '1 4 ,ht) + (puthash '2 5 ,ht) + (dolist (,var (list ,alist ,vec ,ht)) + ,@body)))) (ert-deftest test-map-elt () - (with-maps-do alist vec ht - (assert (= 2 (map-elt alist 'a))) - (assert (= 3 (map-elt alist 'b))) - (assert (= 4 (map-elt alist 'c))) - (assert (null (map-elt alist 'd))) - (assert (= 2 (map-elt ht 'a))) - (assert (= 3 (map-elt ht 'b))) - (assert (= 4 (map-elt ht 'c))) - (assert (null (map-elt ht 'd))) - (assert (eq 'a (map-elt vec 0))) - (assert (eq 'b (map-elt vec 1))) - (assert (eq 'c (map-elt vec 2))) - (assert (null (map-elt vec 3))))) + (with-maps-do map + (assert (= 3 (map-elt map 0))) + (assert (= 4 (map-elt map 1))) + (assert (= 5 (map-elt map 2))) + (assert (null (map-elt map 4))))) (ert-deftest test-map-elt-default () - (with-maps-do alist vec ht - (assert (= 5 (map-elt alist 'd 5))) - (assert (= 5 (map-elt vec 4 5))) - (assert (= 5 (map-elt ht 'd 5))))) + (with-maps-do map + (assert (= 5 (map-elt map 7 5))))) (ert-deftest test-map-put () - (with-maps-do alist vec ht - (map-put alist 'd 4) - (assert (= (map-elt alist 'd) 4)) - (map-put alist 'd 5) - (assert (= (map-elt alist 'd) 5)) - (map-put ht 'd 4) - (assert (= (map-elt ht 'd) 4)) - (map-put ht 'd 5) - (assert (= (map-elt ht 'd) 5)) - (map-put vec 0 'd) - (assert (eq (map-elt vec 0) 'd)) - (should-error (map-put vec 4 'd)))) + (with-maps-do map + (map-put map 2 'hello) + (assert (eq (map-elt map 2) 'hello))) + (let ((ht (make-hash-table))) + (map-put ht 2 'a) + (assert (eq (map-elt ht 2) + 'a))) + (let ((alist '((0 . a) (1 . b) (2 . c)))) + (map-put alist 2 'a) + (assert (eq (map-elt alist 2) + 'a))) + (let ((vec [3 4 5])) + (should-error (map-put vec 3 6)))) (ert-deftest test-map-put-literal () (assert (= (map-elt (map-put [1 2 3] 1 4) 1) @@ -93,13 +93,9 @@ (assert (eq (map-put ht 'a 'hello) ht)))) (ert-deftest test-map-delete () - (with-maps-do alist vec ht - (map-delete alist 'a) - (assert (null (map-elt alist 'a))) - (map-delete ht 'a) - (assert (null (map-elt ht 'a))) - (map-delete vec 2) - (assert (null (map-elt vec 2))))) + (with-maps-do map + (map-delete map 1) + (assert (null (map-elt map 1))))) (ert-deftest test-map-delete-return-value () (let ((ht (make-hash-table))) @@ -136,32 +132,24 @@ (assert (map-p [1 2 3])) (assert (map-p (make-hash-table))) (assert (map-p "hello")) - (with-maps-do alist vec ht - (assert (map-p alist)) - (assert (map-p vec)) - (assert (map-p ht)) - (assert (not (map-p 1))) - (assert (not (map-p 'hello))))) + (assert (not (map-p 1))) + (assert (not (map-p 'hello)))) (ert-deftest test-map-keys () - (with-maps-do alist vec ht - (assert (equal (map-keys alist) '(a b c))) - (assert (equal (map-keys vec) '(0 1 2))) - (assert (equal (map-keys ht) '(a b c))))) + (with-maps-do map + (assert (equal (map-keys map) '(0 1 2)))) + (assert (null (map-keys nil))) + (assert (null (map-keys [])))) (ert-deftest test-map-values () - (with-maps-do alist vec ht - (assert (equal (map-values alist) '(2 3 4))) - (assert (equal (map-values vec) '(a b c))) - (assert (equal (map-values ht) '(2 3 4))))) + (with-maps-do map + (assert (equal (map-values map) '(3 4 5))))) (ert-deftest test-map-pairs () - (with-maps-do alist vec ht - (assert (equal (map-pairs alist) alist)) - (assert (equal (map-pairs vec) '((0 . a) - (1 . b) - (2 . c)))) - (assert (equal (map-pairs ht) alist)))) + (with-maps-do map + (assert (equal (map-pairs map) '((0 . 3) + (1 . 4) + (2 . 5)))))) (ert-deftest test-map-length () (let ((ht (make-hash-table))) @@ -177,19 +165,18 @@ (assert (= 4 (map-length ht))))) (ert-deftest test-map-copy () - (with-maps-do alist vec ht - (dolist (map (list alist vec ht)) - (let ((copy (map-copy map))) - (assert (equal (map-keys map) (map-keys copy))) - (assert (equal (map-values map) (map-values copy))) - (assert (not (eq map copy))))))) + (with-maps-do map + (let ((copy (map-copy map))) + (assert (equal (map-keys map) (map-keys copy))) + (assert (equal (map-values map) (map-values copy))) + (assert (not (eq map copy)))))) (ert-deftest test-map-apply () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-apply (lambda (k v) (cons (symbol-name k) v)) - map) - '(("a" . 2) ("b" . 3) ("c" . 4))))) + (with-maps-do map + (assert (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) + map) + '(("0" . 3) ("1" . 4) ("2" . 5))))) + (let ((vec [a b c])) (assert (equal (map-apply (lambda (k v) (cons (1+ k) v)) vec) '((1 . a) @@ -197,64 +184,62 @@ (3 . c)))))) (ert-deftest test-map-keys-apply () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-keys-apply (lambda (k) (symbol-name k)) - map) - '("a" "b" "c")))) + (with-maps-do map + (assert (equal (map-keys-apply (lambda (k) (int-to-string k)) + map) + '("0" "1" "2")))) + (let ((vec [a b c])) (assert (equal (map-keys-apply (lambda (k) (1+ k)) - vec) + vec) '(1 2 3))))) (ert-deftest test-map-values-apply () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-values-apply (lambda (v) (1+ v)) - map) - '(3 4 5)))) + (with-maps-do map + (assert (equal (map-values-apply (lambda (v) (1+ v)) + map) + '(4 5 6)))) + (let ((vec [a b c])) (assert (equal (map-values-apply (lambda (v) (symbol-name v)) - vec) + vec) '("a" "b" "c"))))) (ert-deftest test-map-filter () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-keys (map-filter (lambda (k v) - (<= 3 v)) - map)) - '(b c))) - (assert (null (map-filter (lambda (k v) - (eq 'd k)) - map)))) + (with-maps-do map + (assert (equal (map-keys (map-filter (lambda (k v) + (<= 4 v)) + map)) + '(1 2))) (assert (null (map-filter (lambda (k v) - (eq 3 v)) - [1 2 4 5]))) - (assert (equal (map-filter (lambda (k v) - (eq 3 k)) - [1 2 4 5]) - '((3 . 5)))))) + (eq 'd k)) + map)))) + (assert (null (map-filter (lambda (k v) + (eq 3 v)) + [1 2 4 5]))) + (assert (equal (map-filter (lambda (k v) + (eq 3 k)) + [1 2 4 5]) + '((3 . 5))))) (ert-deftest test-map-remove () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-keys (map-remove (lambda (k v) - (<= 3 v)) - map)) - '(a))) - (assert (equal (map-keys (map-remove (lambda (k v) - (eq 'd k)) - map)) - (map-keys map)))) - (assert (equal (map-remove (lambda (k v) - (eq 3 v)) - [1 2 4 5]) - '((0 . 1) - (1 . 2) - (2 . 4) - (3 . 5)))) - (assert (null (map-remove (lambda (k v) - (>= k 0)) - [1 2 4 5]))))) + (with-maps-do map + (assert (equal (map-keys (map-remove (lambda (k v) + (>= v 4)) + map)) + '(0))) + (assert (equal (map-keys (map-remove (lambda (k v) + (eq 'd k)) + map)) + (map-keys map)))) + (assert (equal (map-remove (lambda (k v) + (eq 3 v)) + [1 2 4 5]) + '((0 . 1) + (1 . 2) + (2 . 4) + (3 . 5)))) + (assert (null (map-remove (lambda (k v) + (>= k 0)) + [1 2 4 5])))) (ert-deftest test-map-empty-p () (assert (map-empty-p nil)) @@ -274,15 +259,15 @@ (assert (not (map-contains-key-p [a b c] 3)))) (ert-deftest test-map-some-p () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-some-p (lambda (k v) - (eq 'a k)) - map) - (cons 'a 2))) - (assert (not (map-some-p (lambda (k v) - (eq 'd k)) - map)))) + (with-maps-do map + (assert (equal (map-some-p (lambda (k v) + (eq 1 k)) + map) + (cons 1 4))) + (assert (not (map-some-p (lambda (k v) + (eq 'd k)) + map)))) + (let ((vec [a b c])) (assert (equal (map-some-p (lambda (k v) (> k 1)) vec) @@ -292,24 +277,25 @@ vec))))) (ert-deftest test-map-every-p () - (with-maps-do alist vec ht - (dolist (map (list alist ht vec)) - (assert (map-every-p (lambda (k v) - k) - map)) - (assert (not (map-every-p (lambda (k v) - nil) - map)))) + (with-maps-do map + (assert (map-every-p (lambda (k v) + k) + map)) + (assert (not (map-every-p (lambda (k v) + nil) + map)))) + (let ((vec [a b c])) (assert (map-every-p (lambda (k v) (>= k 0)) vec)) (assert (not (map-every-p (lambda (k v) - (> k 3)) + (> k 3)) vec))))) (ert-deftest test-map-into () - (with-maps-do alist vec ht - (assert (hash-table-p (map-into alist 'hash-table))) + (let* ((alist '((a . 1) (b . 2))) + (ht (map-into alist 'hash-table))) + (assert (hash-table-p ht)) (assert (equal (map-into (map-into alist 'hash-table) 'list) alist)) (assert (listp (map-into ht 'list))) commit be3d269d525dc2717f2a757c42344a9bfbdfe4f2 Author: Nicolas Petton Date: Tue Apr 21 19:40:57 2015 +0200 * test/automated/map-tests.el: Renamed from map-test.el. diff --git a/test/automated/map-test.el b/test/automated/map-test.el deleted file mode 100644 index ea7b0af..0000000 --- a/test/automated/map-test.el +++ /dev/null @@ -1,325 +0,0 @@ -;;; map-tests.el --- Tests for map.el - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Nicolas Petton -;; Maintainer: emacs-devel@gnu.org - -;; 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 . - -;;; Commentary: - -;; Tests for map.el - -;;; Code: - -(require 'ert) -(require 'map) - -(defmacro with-maps-do (alist-name vec-name ht-name &rest body) - (declare (indent 3)) - `(let ((,alist-name '((a . 2) - (b . 3) - (c . 4))) - (,vec-name (make-vector 3 nil)) - (,ht-name (make-hash-table))) - (aset ,vec-name 0 'a) - (aset ,vec-name 1 'b) - (aset ,vec-name 2 'c) - (puthash 'a 2 ,ht-name) - (puthash 'b 3 ,ht-name) - (puthash 'c 4 ,ht-name) - (progn - ,@body))) - -(ert-deftest test-map-elt () - (with-maps-do alist vec ht - (assert (= 2 (map-elt alist 'a))) - (assert (= 3 (map-elt alist 'b))) - (assert (= 4 (map-elt alist 'c))) - (assert (null (map-elt alist 'd))) - (assert (= 2 (map-elt ht 'a))) - (assert (= 3 (map-elt ht 'b))) - (assert (= 4 (map-elt ht 'c))) - (assert (null (map-elt ht 'd))) - (assert (eq 'a (map-elt vec 0))) - (assert (eq 'b (map-elt vec 1))) - (assert (eq 'c (map-elt vec 2))) - (assert (null (map-elt vec 3))))) - -(ert-deftest test-map-elt-default () - (with-maps-do alist vec ht - (assert (= 5 (map-elt alist 'd 5))) - (assert (= 5 (map-elt vec 4 5))) - (assert (= 5 (map-elt ht 'd 5))))) - -(ert-deftest test-map-put () - (with-maps-do alist vec ht - (map-put alist 'd 4) - (assert (= (map-elt alist 'd) 4)) - (map-put alist 'd 5) - (assert (= (map-elt alist 'd) 5)) - (map-put ht 'd 4) - (assert (= (map-elt ht 'd) 4)) - (map-put ht 'd 5) - (assert (= (map-elt ht 'd) 5)) - (map-put vec 0 'd) - (assert (eq (map-elt vec 0) 'd)) - (should-error (map-put vec 4 'd)))) - -(ert-deftest test-map-put-literal () - (assert (= (map-elt (map-put [1 2 3] 1 4) 1) - 4)) - (assert (= (map-elt (map-put (make-hash-table) 'a 2) 'a) - 2)) - (should-error (map-put '((a . 1)) 'b 2)) - (should-error (map-put '() 'a 1))) - -(ert-deftest test-map-put-return-value () - (let ((ht (make-hash-table))) - (assert (eq (map-put ht 'a 'hello) ht)))) - -(ert-deftest test-map-delete () - (with-maps-do alist vec ht - (map-delete alist 'a) - (assert (null (map-elt alist 'a))) - (map-delete ht 'a) - (assert (null (map-elt ht 'a))) - (map-delete vec 2) - (assert (null (map-elt vec 2))))) - -(ert-deftest test-map-delete-return-value () - (let ((ht (make-hash-table))) - (assert (eq (map-delete ht 'a) ht)))) - -(ert-deftest test-map-nested-elt () - (let ((vec [a b [c d [e f]]])) - (assert (eq (map-nested-elt vec '(2 2 0)) 'e))) - (let ((alist '((a . 1) - (b . ((c . 2) - (d . 3) - (e . ((f . 4) - (g . 5)))))))) - (assert (eq (map-nested-elt alist '(b e f)) - 4))) - (let ((ht (make-hash-table))) - (map-put ht 'a 1) - (map-put ht 'b (make-hash-table)) - (map-put (map-elt ht 'b) 'c 2) - (assert (eq (map-nested-elt ht '(b c)) - 2)))) - -(ert-deftest test-map-nested-elt-default () - (let ((vec [a b [c d]])) - (assert (null (map-nested-elt vec '(2 3)))) - (assert (null (map-nested-elt vec '(2 1 1)))) - (assert (= 4 (map-nested-elt vec '(2 1 1) 4))))) - -(ert-deftest test-map-p () - (assert (map-p nil)) - (assert (map-p '((a . b) (c . d)))) - (assert (map-p '(a b c d))) - (assert (map-p [])) - (assert (map-p [1 2 3])) - (assert (map-p (make-hash-table))) - (assert (map-p "hello")) - (with-maps-do alist vec ht - (assert (map-p alist)) - (assert (map-p vec)) - (assert (map-p ht)) - (assert (not (map-p 1))) - (assert (not (map-p 'hello))))) - -(ert-deftest test-map-keys () - (with-maps-do alist vec ht - (assert (equal (map-keys alist) '(a b c))) - (assert (equal (map-keys vec) '(0 1 2))) - (assert (equal (map-keys ht) '(a b c))))) - -(ert-deftest test-map-values () - (with-maps-do alist vec ht - (assert (equal (map-values alist) '(2 3 4))) - (assert (equal (map-values vec) '(a b c))) - (assert (equal (map-values ht) '(2 3 4))))) - -(ert-deftest test-map-pairs () - (with-maps-do alist vec ht - (assert (equal (map-pairs alist) alist)) - (assert (equal (map-pairs vec) '((0 . a) - (1 . b) - (2 . c)))) - (assert (equal (map-pairs ht) alist)))) - -(ert-deftest test-map-length () - (let ((ht (make-hash-table))) - (puthash 'a 1 ht) - (puthash 'b 2 ht) - (puthash 'c 3 ht) - (puthash 'd 4 ht) - (assert (= 0 (map-length nil))) - (assert (= 0 (map-length []))) - (assert (= 0 (map-length (make-hash-table)))) - (assert (= 5 (map-length [0 1 2 3 4]))) - (assert (= 2 (map-length '((a . 1) (b . 2))))) - (assert (= 4 (map-length ht))))) - -(ert-deftest test-map-copy () - (with-maps-do alist vec ht - (dolist (map (list alist vec ht)) - (let ((copy (map-copy map))) - (assert (equal (map-keys map) (map-keys copy))) - (assert (equal (map-values map) (map-values copy))) - (assert (not (eq map copy))))))) - -(ert-deftest test-map-apply () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-apply (lambda (k v) (cons (symbol-name k) v)) - map) - '(("a" . 2) ("b" . 3) ("c" . 4))))) - (assert (equal (map-apply (lambda (k v) (cons (1+ k) v)) - vec) - '((1 . a) - (2 . b) - (3 . c)))))) - -(ert-deftest test-map-keys-apply () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-keys-apply (lambda (k) (symbol-name k)) - map) - '("a" "b" "c")))) - (assert (equal (map-keys-apply (lambda (k) (1+ k)) - vec) - '(1 2 3))))) - -(ert-deftest test-map-values-apply () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-values-apply (lambda (v) (1+ v)) - map) - '(3 4 5)))) - (assert (equal (map-values-apply (lambda (v) (symbol-name v)) - vec) - '("a" "b" "c"))))) - -(ert-deftest test-map-filter () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-keys (map-filter (lambda (k v) - (<= 3 v)) - map)) - '(b c))) - (assert (null (map-filter (lambda (k v) - (eq 'd k)) - map)))) - (assert (null (map-filter (lambda (k v) - (eq 3 v)) - [1 2 4 5]))) - (assert (equal (map-filter (lambda (k v) - (eq 3 k)) - [1 2 4 5]) - '((3 . 5)))))) - -(ert-deftest test-map-remove () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-keys (map-remove (lambda (k v) - (<= 3 v)) - map)) - '(a))) - (assert (equal (map-keys (map-remove (lambda (k v) - (eq 'd k)) - map)) - (map-keys map)))) - (assert (equal (map-remove (lambda (k v) - (eq 3 v)) - [1 2 4 5]) - '((0 . 1) - (1 . 2) - (2 . 4) - (3 . 5)))) - (assert (null (map-remove (lambda (k v) - (>= k 0)) - [1 2 4 5]))))) - -(ert-deftest test-map-empty-p () - (assert (map-empty-p nil)) - (assert (not (map-empty-p '((a . b) (c . d))))) - (assert (map-empty-p [])) - (assert (not (map-empty-p [1 2 3]))) - (assert (map-empty-p (make-hash-table))) - (assert (not (map-empty-p "hello"))) - (assert (map-empty-p ""))) - -(ert-deftest test-map-contains-key-p () - (assert (map-contains-key-p '((a . 1) (b . 2)) 'a)) - (assert (not (map-contains-key-p '((a . 1) (b . 2)) 'c))) - (assert (map-contains-key-p '(("a" . 1)) "a")) - (assert (not (map-contains-key-p '(("a" . 1)) "a" #'eq))) - (assert (map-contains-key-p [a b c] 2)) - (assert (not (map-contains-key-p [a b c] 3)))) - -(ert-deftest test-map-some-p () - (with-maps-do alist vec ht - (dolist (map (list alist ht)) - (assert (equal (map-some-p (lambda (k v) - (eq 'a k)) - map) - (cons 'a 2))) - (assert (not (map-some-p (lambda (k v) - (eq 'd k)) - map)))) - (assert (equal (map-some-p (lambda (k v) - (> k 1)) - vec) - (cons 2 'c))) - (assert (not (map-some-p (lambda (k v) - (> k 3)) - vec))))) - -(ert-deftest test-map-every-p () - (with-maps-do alist vec ht - (dolist (map (list alist ht vec)) - (assert (map-every-p (lambda (k v) - k) - map)) - (assert (not (map-every-p (lambda (k v) - nil) - map)))) - (assert (map-every-p (lambda (k v) - (>= k 0)) - vec)) - (assert (not (map-every-p (lambda (k v) - (> k 3)) - vec))))) - -(ert-deftest test-map-into () - (with-maps-do alist vec ht - (assert (hash-table-p (map-into alist 'hash-table))) - (assert (equal (map-into (map-into alist 'hash-table) 'list) - alist)) - (assert (listp (map-into ht 'list))) - (assert (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) - (map-keys ht))) - (assert (equal (map-values (map-into (map-into ht 'list) 'hash-table)) - (map-values ht))) - (assert (null (map-into nil 'list))) - (assert (map-empty-p (map-into nil 'hash-table))) - (should-error (map-into [1 2 3] 'string)))) - -(provide 'map-tests) -;;; map-tests.el ends here diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el new file mode 100644 index 0000000..ea7b0af --- /dev/null +++ b/test/automated/map-tests.el @@ -0,0 +1,325 @@ +;;; map-tests.el --- Tests for map.el + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; Maintainer: emacs-devel@gnu.org + +;; 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 . + +;;; Commentary: + +;; Tests for map.el + +;;; Code: + +(require 'ert) +(require 'map) + +(defmacro with-maps-do (alist-name vec-name ht-name &rest body) + (declare (indent 3)) + `(let ((,alist-name '((a . 2) + (b . 3) + (c . 4))) + (,vec-name (make-vector 3 nil)) + (,ht-name (make-hash-table))) + (aset ,vec-name 0 'a) + (aset ,vec-name 1 'b) + (aset ,vec-name 2 'c) + (puthash 'a 2 ,ht-name) + (puthash 'b 3 ,ht-name) + (puthash 'c 4 ,ht-name) + (progn + ,@body))) + +(ert-deftest test-map-elt () + (with-maps-do alist vec ht + (assert (= 2 (map-elt alist 'a))) + (assert (= 3 (map-elt alist 'b))) + (assert (= 4 (map-elt alist 'c))) + (assert (null (map-elt alist 'd))) + (assert (= 2 (map-elt ht 'a))) + (assert (= 3 (map-elt ht 'b))) + (assert (= 4 (map-elt ht 'c))) + (assert (null (map-elt ht 'd))) + (assert (eq 'a (map-elt vec 0))) + (assert (eq 'b (map-elt vec 1))) + (assert (eq 'c (map-elt vec 2))) + (assert (null (map-elt vec 3))))) + +(ert-deftest test-map-elt-default () + (with-maps-do alist vec ht + (assert (= 5 (map-elt alist 'd 5))) + (assert (= 5 (map-elt vec 4 5))) + (assert (= 5 (map-elt ht 'd 5))))) + +(ert-deftest test-map-put () + (with-maps-do alist vec ht + (map-put alist 'd 4) + (assert (= (map-elt alist 'd) 4)) + (map-put alist 'd 5) + (assert (= (map-elt alist 'd) 5)) + (map-put ht 'd 4) + (assert (= (map-elt ht 'd) 4)) + (map-put ht 'd 5) + (assert (= (map-elt ht 'd) 5)) + (map-put vec 0 'd) + (assert (eq (map-elt vec 0) 'd)) + (should-error (map-put vec 4 'd)))) + +(ert-deftest test-map-put-literal () + (assert (= (map-elt (map-put [1 2 3] 1 4) 1) + 4)) + (assert (= (map-elt (map-put (make-hash-table) 'a 2) 'a) + 2)) + (should-error (map-put '((a . 1)) 'b 2)) + (should-error (map-put '() 'a 1))) + +(ert-deftest test-map-put-return-value () + (let ((ht (make-hash-table))) + (assert (eq (map-put ht 'a 'hello) ht)))) + +(ert-deftest test-map-delete () + (with-maps-do alist vec ht + (map-delete alist 'a) + (assert (null (map-elt alist 'a))) + (map-delete ht 'a) + (assert (null (map-elt ht 'a))) + (map-delete vec 2) + (assert (null (map-elt vec 2))))) + +(ert-deftest test-map-delete-return-value () + (let ((ht (make-hash-table))) + (assert (eq (map-delete ht 'a) ht)))) + +(ert-deftest test-map-nested-elt () + (let ((vec [a b [c d [e f]]])) + (assert (eq (map-nested-elt vec '(2 2 0)) 'e))) + (let ((alist '((a . 1) + (b . ((c . 2) + (d . 3) + (e . ((f . 4) + (g . 5)))))))) + (assert (eq (map-nested-elt alist '(b e f)) + 4))) + (let ((ht (make-hash-table))) + (map-put ht 'a 1) + (map-put ht 'b (make-hash-table)) + (map-put (map-elt ht 'b) 'c 2) + (assert (eq (map-nested-elt ht '(b c)) + 2)))) + +(ert-deftest test-map-nested-elt-default () + (let ((vec [a b [c d]])) + (assert (null (map-nested-elt vec '(2 3)))) + (assert (null (map-nested-elt vec '(2 1 1)))) + (assert (= 4 (map-nested-elt vec '(2 1 1) 4))))) + +(ert-deftest test-map-p () + (assert (map-p nil)) + (assert (map-p '((a . b) (c . d)))) + (assert (map-p '(a b c d))) + (assert (map-p [])) + (assert (map-p [1 2 3])) + (assert (map-p (make-hash-table))) + (assert (map-p "hello")) + (with-maps-do alist vec ht + (assert (map-p alist)) + (assert (map-p vec)) + (assert (map-p ht)) + (assert (not (map-p 1))) + (assert (not (map-p 'hello))))) + +(ert-deftest test-map-keys () + (with-maps-do alist vec ht + (assert (equal (map-keys alist) '(a b c))) + (assert (equal (map-keys vec) '(0 1 2))) + (assert (equal (map-keys ht) '(a b c))))) + +(ert-deftest test-map-values () + (with-maps-do alist vec ht + (assert (equal (map-values alist) '(2 3 4))) + (assert (equal (map-values vec) '(a b c))) + (assert (equal (map-values ht) '(2 3 4))))) + +(ert-deftest test-map-pairs () + (with-maps-do alist vec ht + (assert (equal (map-pairs alist) alist)) + (assert (equal (map-pairs vec) '((0 . a) + (1 . b) + (2 . c)))) + (assert (equal (map-pairs ht) alist)))) + +(ert-deftest test-map-length () + (let ((ht (make-hash-table))) + (puthash 'a 1 ht) + (puthash 'b 2 ht) + (puthash 'c 3 ht) + (puthash 'd 4 ht) + (assert (= 0 (map-length nil))) + (assert (= 0 (map-length []))) + (assert (= 0 (map-length (make-hash-table)))) + (assert (= 5 (map-length [0 1 2 3 4]))) + (assert (= 2 (map-length '((a . 1) (b . 2))))) + (assert (= 4 (map-length ht))))) + +(ert-deftest test-map-copy () + (with-maps-do alist vec ht + (dolist (map (list alist vec ht)) + (let ((copy (map-copy map))) + (assert (equal (map-keys map) (map-keys copy))) + (assert (equal (map-values map) (map-values copy))) + (assert (not (eq map copy))))))) + +(ert-deftest test-map-apply () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-apply (lambda (k v) (cons (symbol-name k) v)) + map) + '(("a" . 2) ("b" . 3) ("c" . 4))))) + (assert (equal (map-apply (lambda (k v) (cons (1+ k) v)) + vec) + '((1 . a) + (2 . b) + (3 . c)))))) + +(ert-deftest test-map-keys-apply () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-keys-apply (lambda (k) (symbol-name k)) + map) + '("a" "b" "c")))) + (assert (equal (map-keys-apply (lambda (k) (1+ k)) + vec) + '(1 2 3))))) + +(ert-deftest test-map-values-apply () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-values-apply (lambda (v) (1+ v)) + map) + '(3 4 5)))) + (assert (equal (map-values-apply (lambda (v) (symbol-name v)) + vec) + '("a" "b" "c"))))) + +(ert-deftest test-map-filter () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-keys (map-filter (lambda (k v) + (<= 3 v)) + map)) + '(b c))) + (assert (null (map-filter (lambda (k v) + (eq 'd k)) + map)))) + (assert (null (map-filter (lambda (k v) + (eq 3 v)) + [1 2 4 5]))) + (assert (equal (map-filter (lambda (k v) + (eq 3 k)) + [1 2 4 5]) + '((3 . 5)))))) + +(ert-deftest test-map-remove () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-keys (map-remove (lambda (k v) + (<= 3 v)) + map)) + '(a))) + (assert (equal (map-keys (map-remove (lambda (k v) + (eq 'd k)) + map)) + (map-keys map)))) + (assert (equal (map-remove (lambda (k v) + (eq 3 v)) + [1 2 4 5]) + '((0 . 1) + (1 . 2) + (2 . 4) + (3 . 5)))) + (assert (null (map-remove (lambda (k v) + (>= k 0)) + [1 2 4 5]))))) + +(ert-deftest test-map-empty-p () + (assert (map-empty-p nil)) + (assert (not (map-empty-p '((a . b) (c . d))))) + (assert (map-empty-p [])) + (assert (not (map-empty-p [1 2 3]))) + (assert (map-empty-p (make-hash-table))) + (assert (not (map-empty-p "hello"))) + (assert (map-empty-p ""))) + +(ert-deftest test-map-contains-key-p () + (assert (map-contains-key-p '((a . 1) (b . 2)) 'a)) + (assert (not (map-contains-key-p '((a . 1) (b . 2)) 'c))) + (assert (map-contains-key-p '(("a" . 1)) "a")) + (assert (not (map-contains-key-p '(("a" . 1)) "a" #'eq))) + (assert (map-contains-key-p [a b c] 2)) + (assert (not (map-contains-key-p [a b c] 3)))) + +(ert-deftest test-map-some-p () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-some-p (lambda (k v) + (eq 'a k)) + map) + (cons 'a 2))) + (assert (not (map-some-p (lambda (k v) + (eq 'd k)) + map)))) + (assert (equal (map-some-p (lambda (k v) + (> k 1)) + vec) + (cons 2 'c))) + (assert (not (map-some-p (lambda (k v) + (> k 3)) + vec))))) + +(ert-deftest test-map-every-p () + (with-maps-do alist vec ht + (dolist (map (list alist ht vec)) + (assert (map-every-p (lambda (k v) + k) + map)) + (assert (not (map-every-p (lambda (k v) + nil) + map)))) + (assert (map-every-p (lambda (k v) + (>= k 0)) + vec)) + (assert (not (map-every-p (lambda (k v) + (> k 3)) + vec))))) + +(ert-deftest test-map-into () + (with-maps-do alist vec ht + (assert (hash-table-p (map-into alist 'hash-table))) + (assert (equal (map-into (map-into alist 'hash-table) 'list) + alist)) + (assert (listp (map-into ht 'list))) + (assert (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) + (map-keys ht))) + (assert (equal (map-values (map-into (map-into ht 'list) 'hash-table)) + (map-values ht))) + (assert (null (map-into nil 'list))) + (assert (map-empty-p (map-into nil 'hash-table))) + (should-error (map-into [1 2 3] 'string)))) + +(provide 'map-tests) +;;; map-tests.el ends here commit a76628fd56c7d8925a15e7f9dfdc485a9fcc2d47 Author: Nicolas Petton Date: Sat Apr 18 20:05:16 2015 +0200 * lisp/emacs-lisp/map.el (map-into): Better error message. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 9d2b4f7..06fd7ad 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -194,7 +194,7 @@ TYPE can be one of the following symbols: list or hash-table." (pcase type (`list (map-pairs map)) (`hash-table (map--into-hash-table map)) - (t (error "Not a map type name: %s" type)))) + (t (error "Not a map type name: %S" type)))) (defmacro map--dispatch (spec &rest args) "Evaluate one of the provided forms depending on the type of MAP. commit 924ea3ff9d8680f4136fe64fc2467460867dd2fe Author: Nicolas Petton Date: Sat Apr 18 20:04:17 2015 +0200 * lisp/emacs-lisp/map.el: Removes byte-compilation warnings. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 7d839f8..9d2b4f7 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -86,11 +86,11 @@ Map can be a nested map composed of alists, hash-tables and arrays." (defun map-keys (map) "Return the list of keys in MAP." - (map-apply (lambda (key value) key) map)) + (map-apply (lambda (key _) key) map)) (defun map-values (map) "Return the list of values in MAP." - (map-apply (lambda (key value) value) map)) + (map-apply (lambda (_ value) value) map)) (defun map-pairs (map) "Return the elements of MAP as key/value association lists." @@ -121,13 +121,13 @@ FUNCTION is called with two arguments, the key and the value." (defun map-keys-apply (function map) "Return the result of applying FUNCTION to each key of MAP." - (map-apply (lambda (key val) + (map-apply (lambda (key _) (funcall function key)) map)) (defun map-values-apply (function map) "Return the result of applying FUNCTION to each value of MAP." - (map-apply (lambda (key val) + (map-apply (lambda (_ val) (funcall function val)) map)) commit 35c27cd5818bede77279dc7e5cf1beec93766baa Author: Nicolas Petton Date: Sat Apr 18 16:35:43 2015 +0200 Throw an error when converting a map into an unknown map type * lisp/emacs-lisp/map.el (map-into): Throw an error if type is not valid. * test/automated/map-test.el: Add a regression test. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index fec0634..7d839f8 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -193,7 +193,8 @@ MAP can be a list, hash-table or array." TYPE can be one of the following symbols: list or hash-table." (pcase type (`list (map-pairs map)) - (`hash-table (map--into-hash-table map)))) + (`hash-table (map--into-hash-table map)) + (t (error "Not a map type name: %s" type)))) (defmacro map--dispatch (spec &rest args) "Evaluate one of the provided forms depending on the type of MAP. diff --git a/test/automated/map-test.el b/test/automated/map-test.el index 8a12be8..ea7b0af 100644 --- a/test/automated/map-test.el +++ b/test/automated/map-test.el @@ -318,7 +318,8 @@ (assert (equal (map-values (map-into (map-into ht 'list) 'hash-table)) (map-values ht))) (assert (null (map-into nil 'list))) - (assert (map-empty-p (map-into nil 'hash-table))))) + (assert (map-empty-p (map-into nil 'hash-table))) + (should-error (map-into [1 2 3] 'string)))) (provide 'map-tests) ;;; map-tests.el ends here commit c3acb3258df5fc0987fdd233062632ed030923d9 Author: Nicolas Petton Date: Sat Apr 18 16:22:16 2015 +0200 New library map.el similar to seq.el but for mapping data structures. * test/automated/map-test.el: New file. * lisp/emacs-lisp/map.el: New file. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el new file mode 100644 index 0000000..fec0634 --- /dev/null +++ b/lisp/emacs-lisp/map.el @@ -0,0 +1,270 @@ +;;; map.el --- Map manipulation functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; Keywords: convenience, map, hash-table, alist, array +;; Version: 1.0 +;; Package: map + +;; Maintainer: emacs-devel@gnu.org + +;; 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 this program. If not, see . + +;;; Commentary: + +;; map.el provides map-manipulation functions that work on alists, +;; hash-table and arrays. All functions are prefixed with "map-". +;; +;; Functions taking a predicate or iterating over a map using a +;; function take the function as their first argument. All other +;; functions take the map as their first argument. + +;; TODO: +;; - Add support for char-tables +;; - Maybe add support for gv? +;; - See if we can integrate text-properties +;; - A macro similar to let-alist but working on any type of map could +;; be really useful + +;;; Code: + +(require 'seq) + +(defun map-elt (map key &optional default) + "Perform a lookup in MAP of KEY and return its associated value. +If KEY is not found, return DEFAULT which defaults to nil. + +If MAP is a list, `assoc' is used to lookup KEY." + (map--dispatch map + :list (or (cdr (assoc key map)) default) + :hash-table (gethash key map default) + :array (or (ignore-errors (elt map key)) default))) + +(defmacro map-put (map key value) + "In MAP, associate KEY with VALUE and return MAP. +If KEY is already present in MAP, replace its value with VALUE." + (declare (debug t)) + `(progn + (map--dispatch (m ,map m) + :list (setq ,map (cons (cons ,key ,value) m)) + :hash-table (puthash ,key ,value m) + :array (aset m ,key ,value)))) + +(defmacro map-delete (map key) + "In MAP, delete the key KEY if present and return MAP. +If MAP is an array, store nil at the index KEY." + (declare (debug t)) + `(progn + (map--dispatch (m ,map m) + :list (setq ,map (map--delete-alist m ,key)) + :hash-table (remhash ,key m) + :array (aset m ,key nil)))) + +(defun map-nested-elt (map keys &optional default) + "Travserse MAP using KEYS and return the looked up value or DEFAULT if nil. +Map can be a nested map composed of alists, hash-tables and arrays." + (or (seq-reduce (lambda (acc key) + (when (map-p acc) + (map-elt acc key))) + keys + map) + default)) + +(defun map-keys (map) + "Return the list of keys in MAP." + (map-apply (lambda (key value) key) map)) + +(defun map-values (map) + "Return the list of values in MAP." + (map-apply (lambda (key value) value) map)) + +(defun map-pairs (map) + "Return the elements of MAP as key/value association lists." + (map-apply (lambda (key value) + (cons key value)) + map)) + +(defun map-length (map) + "Return the length of MAP." + (length (map-keys map))) + +(defun map-copy (map) + "Return a copy of MAP." + (map--dispatch map + :list (seq-copy map) + :hash-table (copy-hash-table map) + :array (seq-copy map))) + +(defun map-apply (function map) + "Return the result of applying FUNCTION to each element of MAP. +FUNCTION is called with two arguments, the key and the value." + (funcall (map--dispatch map + :list #'map--apply-alist + :hash-table #'map--apply-hash-table + :array #'map--apply-array) + function + map)) + +(defun map-keys-apply (function map) + "Return the result of applying FUNCTION to each key of MAP." + (map-apply (lambda (key val) + (funcall function key)) + map)) + +(defun map-values-apply (function map) + "Return the result of applying FUNCTION to each value of MAP." + (map-apply (lambda (key val) + (funcall function val)) + map)) + +(defun map-filter (pred map) + "Return an alist of the key/val pairs of which (PRED key val) is non-nil in MAP." + (delq nil (map-apply (lambda (key val) + (if (funcall pred key val) + (cons key val) + nil)) + map))) + +(defun map-remove (pred map) + "Return an alist of the key/val pairs of which (PRED key val) is nil in MAP." + (map-filter (lambda (key val) (not (funcall pred key val))) + map)) + +(defun map-p (map) + "Return non-nil if MAP is a map (list, hash-table or array)." + (or (listp map) + (hash-table-p map) + (arrayp map))) + +(defun map-empty-p (map) + "Return non-nil is MAP is empty. +MAP can be a list, hash-table or array." + (null (map-keys map))) + +(defun map-contains-key-p (map key &optional testfn) + "Return non-nil if MAP contain the key KEY, nil otherwise. +Equality is defined by TESTFN if non-nil or by `equal' if nil. +MAP can be a list, hash-table or array." + (seq-contains-p (map-keys map) key testfn)) + +(defun map-some-p (pred map) + "Return any key/value pair for which (PRED key val) is non-nil is MAP." + (catch 'map--break + (map-apply (lambda (key value) + (when (funcall pred key value) + (throw 'map--break (cons key value)))) + map) + nil)) + +(defun map-every-p (pred map) + "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP." + (catch 'map--break + (map-apply (lambda (key value) + (or (funcall pred key value) + (throw 'map--break nil))) + map) + t)) + +(defun map-merge (type &rest maps) + "Merge into a map of type TYPE all the key/value pairs in the maps MAPS." + (let (result) + (while maps + (map-apply (lambda (key value) + (map-put result key value)) + (pop maps))) + (map-into result type))) + +(defun map-into (map type) + "Convert the map MAP into a map of type TYPE. +TYPE can be one of the following symbols: list or hash-table." + (pcase type + (`list (map-pairs map)) + (`hash-table (map--into-hash-table map)))) + +(defmacro map--dispatch (spec &rest args) + "Evaluate one of the provided forms depending on the type of MAP. + +SPEC can be a map or a list of the form (VAR MAP [RESULT]). +ARGS should have the form [TYPE FORM]... + +The following keyword types are meaningful: `:list', +`:hash-table' and `array'. + +An error is thrown if MAP is neither a list, hash-table or array. + +Return RESULT if non-nil or the result of evaluation of the +form. + +\(fn (VAR MAP [RESULT]) &rest ARGS)" + (declare (debug t) (indent 1)) + (unless (listp spec) + (setq spec `(,spec ,spec))) + (let ((map-var (car spec)) + (result-var (make-symbol "result"))) + `(let ((,map-var ,(cadr spec)) + ,result-var) + (setq ,result-var + (cond ((listp ,map-var) ,(plist-get args :list)) + ((hash-table-p ,map-var) ,(plist-get args :hash-table)) + ((arrayp ,map-var) ,(plist-get args :array)) + (t (error "Unsupported map: %s" ,map-var)))) + ,@(when (cddr spec) + `((setq ,result-var ,@(cddr spec)))) + ,result-var))) + +(defun map--apply-alist (function map) + "Private function used to apply FUNCTION over MAP, MAP being an alist." + (seq-map (lambda (pair) + (funcall function + (car pair) + (cdr pair))) + map)) + +(defun map--apply-hash-table (function map) + "Private function used to apply FUNCTION over MAP, MAP being a hash-table." + (let (result) + (maphash (lambda (key value) + (push (funcall function key value) result)) + map) + (nreverse result))) + +(defun map--apply-array (function map) + "Private function used to apply FUNCTION over MAP, MAP being an array." + (let ((index 0)) + (seq-map (lambda (elt) + (prog1 + (funcall function index elt) + (setq index (1+ index)))) + map))) + +(defun map--delete-alist (map key) + "Return MAP with KEY removed." + (seq-remove (lambda (pair) + (equal key (car pair))) + map)) + +(defun map--into-hash-table (map) + "Convert MAP into a hash-table." + (let ((ht (make-hash-table :size (map-length map) + :test 'equal))) + (map-apply (lambda (key value) + (map-put ht key value)) + map) + ht)) + +(provide 'map) +;;; map.el ends here diff --git a/test/automated/map-test.el b/test/automated/map-test.el new file mode 100644 index 0000000..8a12be8 --- /dev/null +++ b/test/automated/map-test.el @@ -0,0 +1,324 @@ +;;; map-tests.el --- Tests for map.el + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; Maintainer: emacs-devel@gnu.org + +;; 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 . + +;;; Commentary: + +;; Tests for map.el + +;;; Code: + +(require 'ert) +(require 'map) + +(defmacro with-maps-do (alist-name vec-name ht-name &rest body) + (declare (indent 3)) + `(let ((,alist-name '((a . 2) + (b . 3) + (c . 4))) + (,vec-name (make-vector 3 nil)) + (,ht-name (make-hash-table))) + (aset ,vec-name 0 'a) + (aset ,vec-name 1 'b) + (aset ,vec-name 2 'c) + (puthash 'a 2 ,ht-name) + (puthash 'b 3 ,ht-name) + (puthash 'c 4 ,ht-name) + (progn + ,@body))) + +(ert-deftest test-map-elt () + (with-maps-do alist vec ht + (assert (= 2 (map-elt alist 'a))) + (assert (= 3 (map-elt alist 'b))) + (assert (= 4 (map-elt alist 'c))) + (assert (null (map-elt alist 'd))) + (assert (= 2 (map-elt ht 'a))) + (assert (= 3 (map-elt ht 'b))) + (assert (= 4 (map-elt ht 'c))) + (assert (null (map-elt ht 'd))) + (assert (eq 'a (map-elt vec 0))) + (assert (eq 'b (map-elt vec 1))) + (assert (eq 'c (map-elt vec 2))) + (assert (null (map-elt vec 3))))) + +(ert-deftest test-map-elt-default () + (with-maps-do alist vec ht + (assert (= 5 (map-elt alist 'd 5))) + (assert (= 5 (map-elt vec 4 5))) + (assert (= 5 (map-elt ht 'd 5))))) + +(ert-deftest test-map-put () + (with-maps-do alist vec ht + (map-put alist 'd 4) + (assert (= (map-elt alist 'd) 4)) + (map-put alist 'd 5) + (assert (= (map-elt alist 'd) 5)) + (map-put ht 'd 4) + (assert (= (map-elt ht 'd) 4)) + (map-put ht 'd 5) + (assert (= (map-elt ht 'd) 5)) + (map-put vec 0 'd) + (assert (eq (map-elt vec 0) 'd)) + (should-error (map-put vec 4 'd)))) + +(ert-deftest test-map-put-literal () + (assert (= (map-elt (map-put [1 2 3] 1 4) 1) + 4)) + (assert (= (map-elt (map-put (make-hash-table) 'a 2) 'a) + 2)) + (should-error (map-put '((a . 1)) 'b 2)) + (should-error (map-put '() 'a 1))) + +(ert-deftest test-map-put-return-value () + (let ((ht (make-hash-table))) + (assert (eq (map-put ht 'a 'hello) ht)))) + +(ert-deftest test-map-delete () + (with-maps-do alist vec ht + (map-delete alist 'a) + (assert (null (map-elt alist 'a))) + (map-delete ht 'a) + (assert (null (map-elt ht 'a))) + (map-delete vec 2) + (assert (null (map-elt vec 2))))) + +(ert-deftest test-map-delete-return-value () + (let ((ht (make-hash-table))) + (assert (eq (map-delete ht 'a) ht)))) + +(ert-deftest test-map-nested-elt () + (let ((vec [a b [c d [e f]]])) + (assert (eq (map-nested-elt vec '(2 2 0)) 'e))) + (let ((alist '((a . 1) + (b . ((c . 2) + (d . 3) + (e . ((f . 4) + (g . 5)))))))) + (assert (eq (map-nested-elt alist '(b e f)) + 4))) + (let ((ht (make-hash-table))) + (map-put ht 'a 1) + (map-put ht 'b (make-hash-table)) + (map-put (map-elt ht 'b) 'c 2) + (assert (eq (map-nested-elt ht '(b c)) + 2)))) + +(ert-deftest test-map-nested-elt-default () + (let ((vec [a b [c d]])) + (assert (null (map-nested-elt vec '(2 3)))) + (assert (null (map-nested-elt vec '(2 1 1)))) + (assert (= 4 (map-nested-elt vec '(2 1 1) 4))))) + +(ert-deftest test-map-p () + (assert (map-p nil)) + (assert (map-p '((a . b) (c . d)))) + (assert (map-p '(a b c d))) + (assert (map-p [])) + (assert (map-p [1 2 3])) + (assert (map-p (make-hash-table))) + (assert (map-p "hello")) + (with-maps-do alist vec ht + (assert (map-p alist)) + (assert (map-p vec)) + (assert (map-p ht)) + (assert (not (map-p 1))) + (assert (not (map-p 'hello))))) + +(ert-deftest test-map-keys () + (with-maps-do alist vec ht + (assert (equal (map-keys alist) '(a b c))) + (assert (equal (map-keys vec) '(0 1 2))) + (assert (equal (map-keys ht) '(a b c))))) + +(ert-deftest test-map-values () + (with-maps-do alist vec ht + (assert (equal (map-values alist) '(2 3 4))) + (assert (equal (map-values vec) '(a b c))) + (assert (equal (map-values ht) '(2 3 4))))) + +(ert-deftest test-map-pairs () + (with-maps-do alist vec ht + (assert (equal (map-pairs alist) alist)) + (assert (equal (map-pairs vec) '((0 . a) + (1 . b) + (2 . c)))) + (assert (equal (map-pairs ht) alist)))) + +(ert-deftest test-map-length () + (let ((ht (make-hash-table))) + (puthash 'a 1 ht) + (puthash 'b 2 ht) + (puthash 'c 3 ht) + (puthash 'd 4 ht) + (assert (= 0 (map-length nil))) + (assert (= 0 (map-length []))) + (assert (= 0 (map-length (make-hash-table)))) + (assert (= 5 (map-length [0 1 2 3 4]))) + (assert (= 2 (map-length '((a . 1) (b . 2))))) + (assert (= 4 (map-length ht))))) + +(ert-deftest test-map-copy () + (with-maps-do alist vec ht + (dolist (map (list alist vec ht)) + (let ((copy (map-copy map))) + (assert (equal (map-keys map) (map-keys copy))) + (assert (equal (map-values map) (map-values copy))) + (assert (not (eq map copy))))))) + +(ert-deftest test-map-apply () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-apply (lambda (k v) (cons (symbol-name k) v)) + map) + '(("a" . 2) ("b" . 3) ("c" . 4))))) + (assert (equal (map-apply (lambda (k v) (cons (1+ k) v)) + vec) + '((1 . a) + (2 . b) + (3 . c)))))) + +(ert-deftest test-map-keys-apply () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-keys-apply (lambda (k) (symbol-name k)) + map) + '("a" "b" "c")))) + (assert (equal (map-keys-apply (lambda (k) (1+ k)) + vec) + '(1 2 3))))) + +(ert-deftest test-map-values-apply () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-values-apply (lambda (v) (1+ v)) + map) + '(3 4 5)))) + (assert (equal (map-values-apply (lambda (v) (symbol-name v)) + vec) + '("a" "b" "c"))))) + +(ert-deftest test-map-filter () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-keys (map-filter (lambda (k v) + (<= 3 v)) + map)) + '(b c))) + (assert (null (map-filter (lambda (k v) + (eq 'd k)) + map)))) + (assert (null (map-filter (lambda (k v) + (eq 3 v)) + [1 2 4 5]))) + (assert (equal (map-filter (lambda (k v) + (eq 3 k)) + [1 2 4 5]) + '((3 . 5)))))) + +(ert-deftest test-map-remove () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-keys (map-remove (lambda (k v) + (<= 3 v)) + map)) + '(a))) + (assert (equal (map-keys (map-remove (lambda (k v) + (eq 'd k)) + map)) + (map-keys map)))) + (assert (equal (map-remove (lambda (k v) + (eq 3 v)) + [1 2 4 5]) + '((0 . 1) + (1 . 2) + (2 . 4) + (3 . 5)))) + (assert (null (map-remove (lambda (k v) + (>= k 0)) + [1 2 4 5]))))) + +(ert-deftest test-map-empty-p () + (assert (map-empty-p nil)) + (assert (not (map-empty-p '((a . b) (c . d))))) + (assert (map-empty-p [])) + (assert (not (map-empty-p [1 2 3]))) + (assert (map-empty-p (make-hash-table))) + (assert (not (map-empty-p "hello"))) + (assert (map-empty-p ""))) + +(ert-deftest test-map-contains-key-p () + (assert (map-contains-key-p '((a . 1) (b . 2)) 'a)) + (assert (not (map-contains-key-p '((a . 1) (b . 2)) 'c))) + (assert (map-contains-key-p '(("a" . 1)) "a")) + (assert (not (map-contains-key-p '(("a" . 1)) "a" #'eq))) + (assert (map-contains-key-p [a b c] 2)) + (assert (not (map-contains-key-p [a b c] 3)))) + +(ert-deftest test-map-some-p () + (with-maps-do alist vec ht + (dolist (map (list alist ht)) + (assert (equal (map-some-p (lambda (k v) + (eq 'a k)) + map) + (cons 'a 2))) + (assert (not (map-some-p (lambda (k v) + (eq 'd k)) + map)))) + (assert (equal (map-some-p (lambda (k v) + (> k 1)) + vec) + (cons 2 'c))) + (assert (not (map-some-p (lambda (k v) + (> k 3)) + vec))))) + +(ert-deftest test-map-every-p () + (with-maps-do alist vec ht + (dolist (map (list alist ht vec)) + (assert (map-every-p (lambda (k v) + k) + map)) + (assert (not (map-every-p (lambda (k v) + nil) + map)))) + (assert (map-every-p (lambda (k v) + (>= k 0)) + vec)) + (assert (not (map-every-p (lambda (k v) + (> k 3)) + vec))))) + +(ert-deftest test-map-into () + (with-maps-do alist vec ht + (assert (hash-table-p (map-into alist 'hash-table))) + (assert (equal (map-into (map-into alist 'hash-table) 'list) + alist)) + (assert (listp (map-into ht 'list))) + (assert (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) + (map-keys ht))) + (assert (equal (map-values (map-into (map-into ht 'list) 'hash-table)) + (map-values ht))) + (assert (null (map-into nil 'list))) + (assert (map-empty-p (map-into nil 'hash-table))))) + +(provide 'map-tests) +;;; map-tests.el ends here